Merge pull request #922 from r-lib/feature/r6

Implement R6 support. Fixes #388.

Author: hadley

NAMESPACE

@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(block_to_rd,default)
+S3method(block_to_rd,roxy_block)
+S3method(block_to_rd,roxy_block_r6class)
 S3method(c,rd)
 S3method(default_export,NULL)
 S3method(default_export,default)
@@ -56,6 +59,7 @@ S3method(object_defaults,data)
 S3method(object_defaults,default)
 S3method(object_defaults,import)
 S3method(object_defaults,package)
+S3method(object_defaults,r6class)
 S3method(object_defaults,rcclass)
 S3method(object_defaults,s3generic)
 S3method(object_defaults,s3method)

NEWS.md

@@ -157,6 +157,12 @@ You can override the default either by calling (e.g.) `roxygenise(load_code = "s
 * `global_options` is no longer passed to all roclet methods. Instead use 
   `roxy_meta_get()` to retrieve values stored in the options (#918).
 
+* `@description` and `@detail` tags automatically generated from the leading
+  description block now have correct line numbers (#917).
+
+* roxygen2 now supports documentation for R6 classes. See the
+  "Rd (documentation) tags" vignette for details (#922).
+
 * `rd_section()` and `roxy_tag_rd()` are now exported so that you can more 
   easily extend `rd_roclet()` with your own tags that genereate output in
   `.Rd` files.

R/block.R

@@ -130,6 +130,11 @@ block_find_object <- function(block, env) {
   )
   block$object <- object
 
+  class(block) <- unique(c(
+    paste0("roxy_block_", class(object)),
+    class(block)
+  ))
+
   # Add in defaults generated from the object
   defaults <- object_defaults(object)
   defaults <- c(defaults, list(roxy_tag("backref", block$file, block$file)))

R/object-from-call.R

@@ -41,7 +41,9 @@ object_from_call <- function(call, env, block, file) {
 
 object_from_name <- function(name, env, block) {
   value <- get(name, env)
-  if (methods::is(value, "refObjectGenerator")) {
+  if (inherits(value, "R6ClassGenerator")) {
+    type <- "r6class"
+  } else if (methods::is(value, "refObjectGenerator")) {
     value <- methods::getClass(as.character(value@className), where = env)
     type <- "rcclass"
   } else if (methods::is(value, "classGeneratorFunction")) {
@@ -268,6 +270,7 @@ object_topic <- function(value, alias, type) {
     s4class = paste0(value@className, "-class"),
     s4generic = value@generic,
     rcclass = paste0(value@className, "-class"),
+    r6class = alias,
     rcmethod = value@name,
     s3generic = alias,
     s3method = alias,

R/object-r6.R

@@ -0,0 +1,118 @@
+#' @export
+object_defaults.r6class <- function(x) {
+  list(
+    roxy_tag("docType", NULL, NULL),
+    roxy_tag(".r6data", NULL, extract_r6_data(x$value))
+  )
+}
+
+extract_r6_data <- function(x) {
+  list(
+    self = extract_r6_self_data(x),
+    super = extract_r6_super_data(x)
+  )
+}
+
+extract_r6_self_data <- function(x) {
+  rbind(
+    extract_r6_methods(x),
+    extract_r6_fields(x),
+    extract_r6_bindings(x)
+  )
+}
+
+omit_r6_methods <- function() {
+  "clone"
+}
+
+extract_r6_methods <- function(x) {
+  method_nms <- setdiff(names(x$public_methods), omit_r6_methods())
+  method_loc <- map_int(
+    x$public_methods[method_nms],
+    function(m) {
+      ref <- utils::getSrcref(m)
+      if (is.null(ref)) stop("R6 class without source references")
+      utils::getSrcLocation(ref)
+    }
+  )
+  method_fnm <- map_chr(
+    x$public_methods[method_nms],
+    function(m) {
+      utils::getSrcFilename(utils::getSrcref(m))
+    }
+  )
+  method_formals <- map(x$public_methods[method_nms], formals)
+
+  data.frame(
+    stringsAsFactors = FALSE,
+    type = if (length(method_loc)) "method" else character(),
+    name = unname(method_nms),
+    file = unname(method_fnm),
+    line = unname(method_loc),
+    formals = I(unname(method_formals))
+  )
+}
+
+extract_r6_fields <- function(x) {
+  field_nms <- names(x$public_fields)
+  data.frame(
+    stringsAsFactors = FALSE,
+    type = rep("field", length(field_nms)),
+    name = as.character(field_nms),
+    file = rep(NA, length(field_nms)),
+    line = rep(NA, length(field_nms)),
+    formals = I(replicate(length(field_nms), NULL))
+  )
+}
+
+extract_r6_bindings <- function(x) {
+  bind_nms <- names(x$active)
+  data.frame(
+    stringsAsFactors = FALSE,
+    type = if (length(bind_nms)) "active" else character(),
+    name = as.character(bind_nms),
+    file = rep(NA, length(bind_nms)),
+    line = rep(NA, length(bind_nms)),
+    formals = I(replicate(length(bind_nms), NULL))
+  )
+}
+
+extract_r6_super_data <- function(x) {
+  if (is.null(x$inherit)) return()
+  super <- x$get_inherit()
+  super_data <- extract_r6_super_data(super)
+
+  method_nms <- setdiff(names(super$public_methods), omit_r6_methods())
+  field_nms <- names(super$public_fields)
+  active_nms <- names(super$active)
+  classname <- super$classname %||% NA_character_
+  pkg <- environmentName(topenv(super$parent_env))
+
+  cls <- rbind(
+    data.frame(
+      stringsAsFactors = FALSE,
+      package = pkg,
+      classname = classname
+    ),
+    super_data$classes
+  )
+
+  types <- rep(
+    c("method", "field", "active"),
+    c(length(method_nms), length(field_nms), length(active_nms))
+  )
+  rsort <- function(x) sort(x, decreasing = TRUE)
+  names <-c(rsort(method_nms), rsort(field_nms), rsort(active_nms))
+  mth <- rbind(
+    data.frame(
+      stringsAsFactors = FALSE,
+      package = rep(pkg, length(names)),
+      classname = rep(classname , length(names)),
+      type = types,
+      name = names
+    ),
+    super_data$members
+  )
+
+  list(classes = cls, members = mth)
+}