R/parse_rd.R

In ropenscilabs/rtd:

## Code copied from rd2roxygen package for now ##
parse_rd_file = function(path) {
  rd = tools::parse_Rd(path)

  tags = vapply(rd, tag, character(1))
  tags = gsub("\\\\", "", tags)
  names(rd) = tags

  # Remove top-level text strings - just line breaks between sections
  rd = rd[tags != "TEXT"]

  out = list()
  # Title, description, value and examples, need to be stitched into a
  # single string.
  out$title = reconstruct(untag(rd$title))
  out$docType = reconstruct(untag(rd$docType))
  out$usage = reconstruct(untag(rd$usage))
  out$desc = gsub("$\n+|\n+^", "", reconstruct(untag(rd$description)))
  out$details = reconstruct(untag(rd$details))
  out$section = paste(reconstruct(untag(rd$section[1])),
                      reconstruct(untag(rd$section[-1])), sep = ': ')
  out$format = reconstruct(untag(rd$format))
  out$value = reconstruct(untag(rd$value))
  out$note = reconstruct(untag(rd$note))
  out$author = gsub('@', '@@', reconstruct(untag(rd$author)))
  out$seealso = reconstruct(untag(rd$seealso))
  out$references = reconstruct(untag(rd$references))
  out$source = reconstruct(untag(rd$source))

  out$examples = reconstruct(untag(rd$examples))

  # Join together aliases and keywords
  out$name = reconstruct(untag(rd$name))
  out$aliases = unname(sapply(rd[names(rd) == "alias"], "[[", 1))
  # If the only alias is the name, then skip it
  if (identical(out$aliases, out$name)) {
    out$aliases = NULL
  }
  out$keywords = unname(sapply(rd[names(rd) == "keyword"], "[[", 1))

  # Pull apart arguments
  arguments = rd$arguments
  arguments = arguments[sapply(arguments, tag) != "TEXT"]
  out$params = unlist(sapply(arguments, function(argument) {
    if (tag(argument) != '\\item') return(NULL)
    paste(if (tag(argument[[1]][[1]]) == "\\dots")
      "\\dots" else gsub(' +', '', argument[[1]]),
      reconstruct(argument[[2]]))
  }))

  out
}

## extract tags
tag = function(x) attr(x, "Rd_tag")

## replace tags
untag = function(x) {
  if (is.null(x)) return(NULL)
  attr(x, "Rd_tag") = "TEXT"
  x
}

## construct strings from rd
reconstruct = function(rd) {
  if (is.null(rd)) return()

  if (is.list(rd)) {
    if (length(tag(rd)) && tag(rd) %in% c('\\item', '\\tabular', '\\eqn', '\\deqn', '\\link')) {
      if (tag(rd) == '\\link')
        return(paste('\\link', sprintf('[%s]', attr(rd, 'Rd_option')), '{', rd, '}', sep = ""))
      if (length(rd) == 2) {
        return(paste(tag(rd), '{', rd[[1]], '}{',
                     paste(sapply(rd[[2]], reconstruct), collapse = ""),
                     '}', sep = "", collapse = ""))
      } else if (length(rd) == 0) return(tag(rd))
    }
    special = tag(rd) == toupper(tag(rd))
    singles = tag(rd) %in% c('\\tab', '\\cr')
    prefix = ifelse(special, "",
                    paste(tag(rd), ifelse(singles, "", "{"), sep = ""))
    suffix = ifelse(special, "", ifelse(singles, "", "}"))
    paste(prefix, paste(sapply(rd, reconstruct), collapse = ""), suffix,
          sep = "")
  } else {
    if (tag(rd) == 'TEXT') gsub('%', '\\%', rd, fixed = TRUE) else rd
  }
}