1#' Blocks 2#' 3#' @description 4#' A `roxy_block` represents a single roxygen2 block. 5#' 6#' The `block_*` functions provide a few helpers for common operations: 7#' * `block_has_tag(blocks, tags)`: does `block` contain any of these `tags`? 8#' * `block_get_tags(block, tags)`: get all instances of `tags` 9#' * `block_get_tag(block, tag)`: get single tag. Returns `NULL` if 0, 10#' throws warning if more than 1. 11#' * `block_get_tag_value(block, tag)`: gets `val` field from single tag. 12#' 13#' @param tags A list of [roxy_tag]s. 14#' @param file,line Location of the `call` (i.e. the line after the last 15#' line of the block). 16#' @param call Expression associated with block. 17#' @param object Optionally, the object associated with the block, found 18#' by inspecting/evaluating `call`. 19#' @param block A `roxy_block` to manipulate. 20#' @param tag,tags Either a single tag name, or a character vector of tag names. 21#' @export 22#' @keywords internal 23#' @examples 24#' # The easiest way to see the structure of a roxy_block is to create one 25#' # using parse_text: 26#' text <- " 27#' #' This is a title 28#' #' 29#' #' @param x,y A number 30#' #' @export 31#' f <- function(x, y) x + y 32#' " 33#' 34#' # parse_text() returns a list of blocks, so I extract the first 35#' block <- parse_text(text)[[1]] 36#' block 37roxy_block <- function(tags, 38 file, 39 line, 40 call, 41 object = NULL) { 42 stopifnot(is.list(tags)) 43 stopifnot(is.character(file), length(file) == 1) 44 stopifnot(is.integer(line), length(line) == 1) 45 46 structure( 47 list( 48 tags = tags, 49 file = file, 50 line = line, 51 call = call, 52 object = object 53 ), 54 class = "roxy_block" 55 ) 56} 57 58is_roxy_block <- function(x) inherits(x, "roxy_block") 59 60#' @export 61print.roxy_block <- function(x, ...) { 62 call <- deparse(x$call, nlines = 2) 63 if (length(call) == 2) { 64 call <- paste0(call[[1]], " ...") 65 } 66 obj <- format(x$object) 67 68 cat_line("<roxy_block> [", basename(x$file), ":", x$line, "]") 69 cat_line(" $tag") 70 cat_line(" ", map_chr(x$tags, format, file = x$file)) 71 cat_line(" $call ", call) 72 cat_line(" $object ", obj[[1]]) 73 cat_line(" ", obj[-1]) 74} 75 76block_create <- function(tokens, call, srcref) { 77 78 pkgenv <- roxy_meta_get("env") 79 # This should only happen in our test cases 80 if (is.null(pkgenv)) pkgenv <- baseenv() 81 evalenv <- new.env(parent = pkgenv) 82 roxy_meta_set("evalenv", evalenv) 83 on.exit(roxy_meta_set("evalenv", NULL), add = TRUE) 84 85 tags <- parse_tags(tokens) 86 if (length(tags) == 0) return() 87 88 roxy_block(tags, 89 file = attr(srcref, "srcfile")$filename, 90 line = as.vector(srcref)[[1]], 91 call = call 92 ) 93} 94 95block_set_env <- function(block, env) { 96 block <- block_evaluate(block, env) 97 block <- block_find_object(block, env) 98 block 99} 100 101block_evaluate <- function(block, env) { 102 103 tags <- block_get_tags(block, "eval") 104 if (length(tags) == 0) { 105 return(block) 106 } 107 108 # Evaluate 109 results <- lapply(tags, roxy_tag_eval, env = env) 110 results <- lapply(results, function(x) { 111 if (is.null(x)) { 112 character() 113 } else { 114 paste0("#' ", x) 115 } 116 }) 117 118 # Tokenise and parse 119 tokens <- lapply(results, tokenise_block, 120 file = block$file, 121 offset = block$line 122 ) 123 tags <- lapply(tokens, parse_tags) 124 125 # Interpolate results back into original locations 126 block_replace_tags(block, "eval", tags) 127} 128 129block_find_object <- function(block, env) { 130 stopifnot(is_roxy_block(block)) 131 132 object <- object_from_call( 133 call = block$call, 134 env = env, 135 block = block, 136 file = block$file 137 ) 138 block$object <- object 139 140 class(block) <- unique(c( 141 paste0("roxy_block_", class(object)), 142 class(block) 143 )) 144 145 # Add in defaults generated from the object 146 defaults <- object_defaults(object) 147 defaults <- c(defaults, list(roxy_tag("backref", block$file, block$file))) 148 149 default_tags <- map_chr(defaults, "tag") 150 defaults <- defaults[!default_tags %in% block_tags(block)] 151 152 block$tags <- c(block$tags, defaults) 153 block 154} 155 156# block accessors --------------------------------------------------------- 157 158block_tags <- function(block) { 159 map_chr(block$tags, "tag") 160} 161 162#' @export 163#' @rdname roxy_block 164block_has_tags <- function(block, tags) { 165 any(block_tags(block) %in% tags) 166} 167 168#' @export 169#' @rdname roxy_block 170block_get_tags <- function(block, tags) { 171 block$tags[block_tags(block) %in% tags] 172} 173 174#' @export 175#' @rdname roxy_block 176block_get_tag <- function(block, tag) { 177 matches <- which(block_tags(block) %in% tag) 178 n <- length(matches) 179 if (n == 0) { 180 NULL 181 } else if (n == 1) { 182 block$tags[[matches]] 183 } else { 184 roxy_tag_warning(block$tags[[matches[[2]]]], "May only use one @", tag, " per block") 185 block$tags[[matches[[1]]]] 186 } 187} 188 189#' @export 190#' @rdname roxy_block 191block_get_tag_value <- function(block, tag) { 192 block_get_tag(block, tag)$val 193} 194 195block_replace_tags <- function(block, tags, values) { 196 indx <- which(block_tags(block) %in% tags) 197 stopifnot(length(indx) == length(values)) 198 199 tags <- lapply(block$tags, list) 200 tags[indx] <- values 201 202 block$tags <- compact(unlist(tags, recursive = FALSE)) 203 block 204} 205 206# parsing ----------------------------------------------------------------- 207 208parse_tags <- function(tokens) { 209 markdown_activate(tokens) 210 211 tokens <- parse_description(tokens) 212 compact(lapply(tokens, roxy_tag_parse)) 213} 214 215#' @export 216roxy_tag_parse.roxy_tag_eval <- function(x) { 217 tag_code(x) 218} 219 220#' @export 221roxy_tag_parse.roxy_tag_include <- function(x) { 222 tag_value(x) 223} 224 225parse_description <- function(tags) { 226 if (length(tags) == 0) { 227 return(tags) 228 } 229 230 tag_names <- vapply(tags, `[[`, "tag", FUN.VALUE = character(1)) 231 if (tag_names[1] != "") { 232 return(tags) 233 } 234 235 intro <- tags[[1]] 236 intro$val <- str_trim(intro$raw) 237 if (intro$val == "") { 238 return(tags[-1]) 239 } 240 241 tags <- tags[-1] 242 tag_names <- tag_names[-1] 243 244 paragraphs <- str_split(intro$val, fixed('\n\n'))[[1]] 245 lines <- str_count(paragraphs, "\n") + rep(2, length(paragraphs)) 246 offsets <- c(0, cumsum(lines)) 247 248 # 1st paragraph = title (unless has @title) 249 if ("title" %in% tag_names) { 250 title <- NULL 251 } else if (length(paragraphs) > 0) { 252 title <- roxy_tag("title", paragraphs[1], NULL, intro$file, intro$line + offsets[[1]]) 253 paragraphs <- paragraphs[-1] 254 offsets <- offsets[-1] 255 } else { 256 title <- roxy_tag("title", "", NULL, intro$file, intro$line) 257 } 258 259 # 2nd paragraph = description (unless has @description) 260 if ("description" %in% tag_names || length(paragraphs) == 0) { 261 description <- NULL 262 } else if (length(paragraphs) > 0) { 263 description <- roxy_tag("description", paragraphs[1], NULL, intro$file, intro$line + offsets[[1]]) 264 paragraphs <- paragraphs[-1] 265 offsets <- offsets[-1] 266 } 267 268 # Every thing else = details, combined with @details 269 if (length(paragraphs) > 0) { 270 details_para <- paste(paragraphs, collapse = "\n\n") 271 272 # Find explicit @details tags 273 didx <- which(tag_names == "details") 274 if (length(didx) > 0) { 275 explicit_details <- map_chr(tags[didx], "raw") 276 tags <- tags[-didx] 277 details_para <- paste(c(details_para, explicit_details), collapse = "\n\n") 278 } 279 280 details <- roxy_tag("details", details_para, NULL, intro$file, intro$line + offsets[[1]]) 281 } else { 282 details <- NULL 283 } 284 285 c(compact(list(title, description, details)), tags) 286} 287