Add @field for documenting RC fields.

Closes #181. Also includes some refactoring for @param and @slot
r-lib · Feb 5, 2014 · 7ea9554 · 7ea9554
1 parent 11b400e
commit 7ea9554
Show file tree

Hide file tree

Showing 9 changed files with 118 additions and 86 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -21,7 +21,6 @@ S3method(default_usage,s4method)
 S3method(escape,character)
 S3method(escape,rd)
 S3method(format,alias_tag)
-S3method(format,arguments_tag)
 S3method(format,author_tag)
 S3method(format,concept_tag)
 S3method(format,description_tag)
@@ -30,12 +29,14 @@ S3method(format,docType_tag)
 S3method(format,encoding_tag)
 S3method(format,examples_tag)
 S3method(format,family_tag)
+S3method(format,field_tag)
 S3method(format,formals_tag)
 S3method(format,format_tag)
 S3method(format,inheritParams_tag)
 S3method(format,keyword_tag)
 S3method(format,name_tag)
 S3method(format,note_tag)
+S3method(format,param_tag)
 S3method(format,rcmethods_tag)
 S3method(format,rd_file)
 S3method(format,rd_tag)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # roxygen2 3.1.0.99
 
+* New `@field` tag for documenting the fields on a reference class. (#181)
+
 # roxygen2 3.1.0
 
 ## Documentation for reference classes

diff --git a/R/inherit-params.R b/R/inherit-params.R
@@ -1,63 +1,63 @@
 process_inherit_params <- function(topics) {
-  
+
   # Currently no topological sort, so @inheritParams will only traverse
   # one-level - you can't inherit params that have been inherited from
   # another function (and you can't currently use multiple inherit tags)
   inherit_index <- get_values(topics, "inheritParams")
   name_index <- get_values(topics, "name")
-  
+
   for(topic_name in names(inherit_index)) {
     topic <- topics[[topic_name]]
 
-    documented <- names(get_tag(topic, "arguments")$values)
+    documented <- names(get_tag(topic, "param")$values)
     if (length(documented) > 0)
       documented <- unlist(strsplit(documented, ","))
-    
+
     needed <- get_tag(topic, "formals")$values
     missing <- setdiff(needed, documented)
     if (length(missing) == 0) next
-    
+
     for(inheritor in inherit_index[[topic_name]]) {
       inherited <- find_params(inheritor, topics, name_index)
-      
+
       to_add <- intersect(missing, names(inherited))
       if (length(to_add) == 0) next
       missing <- setdiff(missing, names(inherited))
-      
-      add_tag(topic, new_tag("arguments", inherited[to_add]))
+
+      add_tag(topic, new_tag("param", inherited[to_add]))
     }
   }
-  
-  topics 
+
+  topics
 }
 
 find_params <- function(inheritor, topics, name_lookup) {
   has_colons <- grepl("::", inheritor, fixed = TRUE)
-  
+
   if (has_colons) {
     # Reference to another package
     pieces <- strsplit(inheritor, "::", fixed = TRUE)[[1]]
     params <- rd_arguments(get_rd(pieces[2], pieces[1]))
-    
+
   } else {
     # Reference within this package
     rd_name <- names(Filter(function(x) inheritor %in% x, name_lookup))
-    
+
     if (length(rd_name) != 1) {
       warning("@inheritParams: can't find topic ", inheritor,
         call. = FALSE, immediate. = TRUE)
       return()
     }
-    params <- get_tag(topics[[rd_name]], "arguments")$values
+    params <- get_tag(topics[[rd_name]], "param")$values
   }
   params <- unlist(params)
-  
+
   param_names <- str_trim(names(params))
   param_names[param_names == "\\dots"] <- "..."
-  
+
   # Split up compound names on , duplicating their contents
   individual_names <- strsplit(param_names, ",")
   reps <- vapply(individual_names, length, integer(1))
-  
+
   setNames(rep.int(params, reps), unlist(individual_names))
-}
+}
diff --git a/R/rd-file-api.R b/R/rd-file-api.R
@@ -24,8 +24,8 @@ names.rd_file <- function(x) {
 format.rd_file <- function(x, ...) {
   tags <- as.list(x[[1]])
   order <- c("docType", "encoding", "name", "alias", "title", "format",
-    "source", "usage", "arguments", "value", "description", 
-    "details", "slot", "rcmethods", "note", "section", "examples", 
+    "source", "usage", "param", "value", "description",
+    "details", "field", "slot", "rcmethods", "note", "section", "examples",
     "author", "references", "seealso", "concept", "keyword")
 
   tags <- tags[intersect(order, names(tags))]

diff --git a/R/rd-tag-api.R b/R/rd-tag-api.R
@@ -121,7 +121,7 @@ format.usage_tag <- function(x, ...) {
 }
 
 #' @export
-format.arguments_tag <- function(x, ...) {
+format.param_tag <- function(x, ...) {
   names <- names(x$values)
   dups <- duplicated(names)
 
@@ -143,14 +143,25 @@ format.section_tag <- function(x, ...) {
 
 #' @export
 format.slot_tag <- function(x, ...) {
-  names <- names(x$values)
-  items <- str_c("\\item{\\code{", names, "}}{", x$values, "}", collapse = "\n\n")
-  str_c("\\section{Slots}{\n\n",
-    "\\describe{\n", 
+  describe_section("Slots", names(x$values), x$values)
+}
+
+#' @export
+format.field_tag <- function(x, ...) {
+  describe_section("Fields", names(x$values), x$values)
+}
+
+describe_section <- function(name, dt, dd) {
+  items <- paste0("\\item{\\code{", dt, "}}{", dd, "}", collapse = "\n\n")
+  paste0("\\section{", name, "}{\n\n",
+    "\\describe{\n",
     items,
-    "\n}}\n")
+    "\n}}\n"
+  )
 }
 
+
+
 #' @export
 format.examples_tag <- function(x, ...) {
   values <- str_c(x$values, collapse = "\n")
@@ -160,9 +171,9 @@ format.examples_tag <- function(x, ...) {
 #' @export
 format.rcmethods_tag <- function(x, ...) {
   paste0(
-    "\\section{Methods}{\n", 
-    "\\itemize{\n", 
+    "\\section{Methods}{\n",
+    "\\itemize{\n",
     paste0("\\item ", x$values, collapse = "\n\n"),
     "\n}}\n"
   )
-}
+}
diff --git a/R/roclet-rd.R b/R/roclet-rd.R
@@ -29,6 +29,7 @@ register.preref.parsers(parse.value,
 register.preref.parsers(parse.name.description,
                         'param',
                         'slot',
+                        'field',
                         'method')
 
 register.preref.parsers(parse.name,
@@ -204,9 +205,9 @@ roc_process.had <- function(roclet, partita, base_path, options = list()) {
       call <- sys.call(-2)
       stop(simpleError(msg, call))
     })
-    
+
     if (is.null(new)) next
-    
+
     old <- topics[[new$filename]]
     topics[[new$filename]] <- if (is.null(old)) new$rd else merge(old, new$rd)
   }
@@ -247,7 +248,7 @@ roclet_rd_one <- function(partitum, base_path) {
   if (any(names(partitum) == "noRd")) return()
 
   # Figure out topic name
-  name <- partitum$name %||% default_topic_name(partitum$object) %||% 
+  name <- partitum$name %||% default_topic_name(partitum$object) %||%
     roxygen_stop("Missing name", srcref = partitum$srcref)
 
   # Work out file name and initialise Rd object
@@ -257,18 +258,19 @@ roclet_rd_one <- function(partitum, base_path) {
   add_tag(rd, new_tag("encoding", partitum$encoding))
   add_tag(rd, new_tag("name", name))
   add_tag(rd, alias_tag(partitum, name))
-  
+
   if (is.function(partitum$object$value)) {
     formals <- formals(partitum$object$value)
-    add_tag(rd, new_tag("formals", names(formals)))    
+    add_tag(rd, new_tag("formals", names(formals)))
   }
 
   add_tag(rd, process_description(partitum, base_path))
   add_tag(rd, process_methods(partitum))
-  
+
   add_tag(rd, usage_tag(partitum))
-  add_tag(rd, process.arguments(partitum))
-  add_tag(rd, process.slot(partitum))
+  add_tag(rd, process_param(partitum))
+  add_tag(rd, process_slot(partitum))
+  add_tag(rd, process_field(partitum))
   add_tag(rd, process.docType(partitum))
   add_tag(rd, process_had_tag(partitum, 'note'))
   add_tag(rd, process_had_tag(partitum, 'family'))
@@ -296,12 +298,12 @@ roclet_rd_one <- function(partitum, base_path) {
 roc_output.had <- function(roclet, results, base_path, options = list()) {
   man <- normalizePath(file.path(base_path, "man"))
 
-  contents <- vapply(results, format, wrap = options$wrap, 
+  contents <- vapply(results, format, wrap = options$wrap,
     FUN.VALUE = character(1))
 
   paths <- file.path(man, names(results))
   mapply(write_if_different, paths, contents)
-  
+
   paths
 }
 
@@ -357,14 +359,14 @@ process_description <- function(partitum, base_path) {
 process_methods <- function(block) {
   obj <- block$object
   if (!inherits(obj, "rcclass")) return()
-  
+
   methods <- obj$methods
   if (is.null(obj$methods)) return()
-  
+
   method_desc <- function(obj) {
     desc <- docstring(obj$value@.Data)
     if (is.null(desc)) return()
-    
+
     paste0("\\code{", function_usage(obj$name, formals(obj$value@.Data)),  "}: ", desc)
   }
 
@@ -373,26 +375,6 @@ process_methods <- function(block) {
 }
 
 
-process.arguments <- function(partitum) {
-  params <- partitum[names(partitum) == "param"]
-  if (length(params) == 0) return()
-
-  desc <- str_trim(sapply(params, "[[", "description"))
-  names(desc) <- sapply(params, "[[", "name")
-
-  new_tag("arguments", desc)
-}
-
-process.slot <- function(partitum) {
-  params <- partitum[names(partitum) == "slot"]
-  if (length(params) == 0) return() 
-
-  desc <- str_trim(sapply(params, "[[", "description"))
-  names(desc) <- sapply(params, "[[", "name")
-
-  new_tag("slot", desc)
-}
-
 # If \code{@@examples} is provided, use that; otherwise, concatenate
 # the files pointed to by each \code{@@example}.
 process.examples <- function(partitum, base_path) {
@@ -436,8 +418,32 @@ process.docType <- function(partitum) {
 }
 
 process_had_tag <- function(partitum, tag, f = new_tag) {
-  matches <- partitum[names(partitum) == tag]  
+  matches <- partitum[names(partitum) == tag]
   if (length(matches) == 0) return()
 
   unlist(lapply(matches, function(p) f(tag, p)), recursive = FALSE)
 }
+
+# Name + description tags ------------------------------------------------------
+
+process_param <- function(block) {
+  process_def_tag(block, "param")
+}
+
+process_slot <- function(block) {
+  process_def_tag(block, "slot")
+}
+
+process_field <- function(block) {
+  process_def_tag(block, "field")
+}
+
+process_def_tag <- function(block, tag) {
+  tags <- block[names(block) == tag]
+  if (length(tags) == 0) return()
+
+  desc <- str_trim(sapply(tags, "[[", "description"))
+  names(desc) <- sapply(tags, "[[", "name")
+
+  new_tag(tag, desc)
+}
diff --git a/inst/tests/test-field.R b/inst/tests/test-field.R
@@ -0,0 +1,12 @@
+context("Field")
+
+test_that("@fields creates a new section and lists fields", {
+  out <- roc_proc_text(rd_roclet(), "
+    #' Important class.
+    #'
+    #' @field a field a
+    #' @field b field b
+    setRefClass('test')
+    ")[[1]]
+  expect_equal(get_tag(out, "field")$values, c(a = "field a", b = "field b"))
+})