### Prefix for code comments used with grep and gsub.
prefix <- "^### "

decomment <- function
### Remove comment prefix and join lines of code to form a
### documentation string. We use base::gsub and base::paste.
(comments
### Character vector of prefixed comment lines.
 ){
  paste(gsub(prefix,"",comments),collapse=" ")
### String without prefixes or newlines.
}

### Necessary fields in DESCRIPTION, otherwise error.
desc.fields <- c("Package","Maintainer","Author","Version",
            "License","Title","Description")
### Default DESCRIPTION, written if it doesn't exist.
empty.description <- matrix("",ncol=length(desc.fields),dimnames=list(NULL,desc.fields))

package.skeleton.dx <- function # Package skeleton deluxe
### Automates more of the setup process for a new source
### package. After inspecting the specified R code files to find
### inline documentation, it calls the standard package.skeleton
### function, which creates bare Rd files. The inline documentation is
### added to these Rd files and then these files are copied to
### ../man. It will overwrite files in the pkgdir/man directory.
(pkgdir="..",
### package directory where the DESCRIPTION file lives. Your code
### should be in pkgdir/R. We will setwd to pkgdir/R for the duration
### of the function, then switch back to where you were previously.
 code_files=NULL,
### Character vector with the names of the R code files, to be passed
### to package.skeleton, and also inspected for inline
### documentation. NULL means all files ending in .R.
 check.type=""
### Value indicating whether or not to check the package after
### documentation is built. Anything other than "" (the default) will
### check the package. "noex" means check the package without running
### examples, only tests (useful for debugging if your tests/examples
### take a long time).
 ){
  chdir <- file.path(pkgdir,"R")
  old.wd <- setwd(chdir)
  on.exit(setwd(old.wd))

  descfile <- file.path("..","DESCRIPTION")
  if(!file.exists(descfile)){
    write.dcf(empty.description,descfile)
    stop("Need ",descfile,"; please fill that in and try again")
  }

  ## Read description and check for errors
  desc <- read.dcf(descfile)
  for(f in desc.fields){
    if(! f %in% colnames(desc))stop("Need ",f," in ",descfile)
    if(desc[,f]=="")stop("Need a value for ",f," in ",descfile)
  }

  ## extract docs from each file
  if(is.null(code_files))code_files <- Sys.glob("*.R")
  docs <- list()
  for(cf in code_files){
    L <- extract.docs.file(cf,check!="noex")
    for(N in names(L))docs[[N]] <- L[[N]]
  }
  for(i in names(docs)){
    docs[[i]]$author <- desc[,"Maintainer"]
    if(! 'title' %in% names(docs[[i]]))
      docs[[i]]$title <- gsub("[._]"," ",i)
  }
  name <- desc[,"Package"]
  details <- paste(paste(colnames(desc),": \\tab ",desc,"\\cr",sep=""),
                   collapse="\n")
  docs[[paste(name,"-package",sep="")]] <-
    list(title=desc[,"Title"],
         description=desc[,"Description"],
         `tabular{ll}`=details,
         author=desc[,"Maintainer"])
  ## Make package skeleton and edit Rd files
  unlink(name,recursive=TRUE)
  package.skeleton(name,code_files=code_files)
  cat("Modifying files automatically generated by package.skeleton:\n")
  for(N in names(docs))modify.Rd.file(N,name,docs)
  file.copy(file.path(name,'man'),"..",recursive=TRUE)
  unlink(name,recursive=TRUE)

  if(check!=""){
    Rdir <- setwd(file.path("..",".."))
    cdir <- basename(dirname(Rdir))
    system(paste("R CMD check",cdir))
  }
  ## rebuild examples if we didn't test them:
  if(check=="noex")package.skeleton.dx(pkgdir,code_files,"")
}

modify.Rd.file <- structure(function
                            ### Add inline documentation from comments to an Rd file
                            ### automatically-generated by package.skeleton.
(N,
  ### Name of function/file to which we will add documentation.
  pkg,
  ### Package name.
  docs
  ### Named list of documentation in extracted comments.
){
  fb <- paste(N,".Rd",sep="")
  f <- file.path(pkg,'man',fb)
  ## If there are no significant docs in the comments then the object
  ## should still be documented, by writing the file by hand in the
  ## man directory. This will write a blank Rd file if none exists, so
  ## it's easy to get started.
  if((length(docs[[N]])<3) &&
       file.exists(file.path("..","man",fb))){
    unlink(f)
    return()
  }
  cat(N,":",sep="")
  d <- docs[[N]]
  dlines <- readLines(f)

  ## cut out alias line if we are in the package file and there is a
  ## matching function
  if(length(grep("-package$",N)))
    dlines <- dlines[-grep(paste("alias[{]",N,sep=""),dlines)-1]

  ## cut out all comments {} interferes with regex matching
  dlines <- dlines[-grep("^[%~]",dlines)]

  ## cut out a couple of sections that cause warnings
  o <- grep("Optionally",dlines)
  if(length(o))dlines <- dlines[-(o:(o+1))]
  ## delete examples til the end of the file (also includes keywords)
  dlines <- dlines[1:(tail(grep("examples[{]$",dlines),1)-1)]
  ## add back a minimal examples section to find and replace
  dlines <- c(dlines,"\\examples{}")

  ## Find and replace based on data in d
  txt <- paste(dlines,collapse="\n")
  for(torep in names(d)){
    cat(" ",torep,sep="")
    FIND1 <- gsub("\\\\","\\\\\\\\",torep)
    FIND <- paste(gsub("([{}])","\\\\\\1",FIND1),"[{][^}]*[}]",sep="")
    ## need to escape backslashes for faithful copying of the comments
    ## to the Rd file:
    REP <- paste(FIND1,"{",gsub("\\\\","\\\\\\\\",d[[torep]]),"}",sep="")
    ## escape percent signs in R code:
    REP <- gsub("%","\\\\\\\\%",REP)
    txt <- gsub(FIND,REP,txt)
  }

  ## Fix usage
  m <- regexpr("usage[{][^}]*[}]",txt)
  Mend <- m+attr(m,"match.length")
  utxt <- substr(txt,m,Mend)
  if(length(grep("usage[{]data",utxt)))
    utxt <- gsub("data[(]([^)]*)[)]","\\1",utxt)
  ## add another backslash due to bug in package.skeleton
  txt <- paste(substr(txt,1,m-1),
               gsub("\\\\","\\\\\\\\",utxt),
               substr(txt,Mend+1,nchar(txt)),
               sep="")
  ## This doesn't work if there are quotes in the default values:
  ## gsub(",",paste("\n",paste(rep(" ",l=nchar(N)-1),collapse="")),utxt)
  cat(txt,file=f)
  cat("\n")
}, ex=function(){
  cat("\\")
})

extract.docs.file <- function # Extract documentation from a file
### Parse an R code file and extract inline documentation from
### comments around each function.
(code.file,
### The R code file to parse.
 write.examples=TRUE
### Gather examples from test files?
 ){
  code <- readLines(code.file)
  comment.lines <- grep(prefix,code)
  e <- new.env()
  old <- options(keep.source.pkgs=TRUE)
  r <- try(sys.source(code.file,e),TRUE)
  if(class(r)=="try-error")
    stop("source ",code.file," failed with error:\n",r)
  options(old)
  objs <- sapply(ls(e),get,e,simplify=FALSE)
  extract.docs <- function(on){
    res <- try({
      o <- objs[[on]]
      doc <- if("function"%in%class(o)){
        tdoc <- extract.docs.fun(o)
        if(write.examples){ ## do not get examples from test files.
          tfile <- file.path("..","tests",paste(on,".R",sep=""))
          if(file.exists(tfile))
            tdoc[["examples"]] <- paste(readLines(tfile),collapse="\n")
        }
        tdoc
      }else list()
      ## Take the line before the first occurence of the variable
      defined.on <- grep(paste("^",on,sep=""),code)[1]-1
      if(!"description"%in%names(doc) && defined.on%in%comment.lines){
        comments.before <- comment.lines[comment.lines<=defined.on]
        these.comment.lines <- if(length(comments.before)==1)comments.before else{
          diffs <- diff(comments.before)
          comments.before[max(which(diffs>1))+1]:defined.on
        }
        doc$description <- decomment(code[these.comment.lines])
      }
      doc
    },FALSE)
    if(class(res)=="try-error"){
      cat("Failed to extract docs for: ",on,"\n\n")
      list()
    }
    else res
  }
  res <- sapply(names(objs),extract.docs,simplify=FALSE)
  res
### named list of lists. Each element is the result of a call to
### extract.docs.fun, with names corresponding to functions found in
### the R code file.
}

extract.docs.fun <- function # Extract documentation from a function
### Given a function, return a list describing inline documentation in
### the source of that function (relies on source attr).
(fun
### The function to examine.
 ){
  res <- list()
  code <- attr(fun,"source")
  clines <- grep("^#",code)
  if(length(grep("#",code[1])))res$title <- gsub("[^#]*#(.*)","\\1",code[1])
  if(length(clines)==0)return(res) ## no comments found
  bounds <- which(diff(clines)!=1)
  starts <- c(1,bounds+1)
  ends <- c(bounds,length(clines))
  for(i in seq_along(starts)){
    start <- clines[starts[i]]
    end <- clines[ends[i]]
    lab <- if(end+1==length(code))"value"
    else if(start==2)"description"
    else {
      arg <- gsub("^[ (]*","",code[start-1])
      arg <- gsub("^([^=,]*)[=,].*","\\1",arg)
      arg <- gsub("...","\\dots",arg,fixed=TRUE) ##special case for dots
      paste("item{",arg,"}",sep="")
    }
    res[[lab]] <- decomment(code[start:end])
  }
  ##details<<
  ## For simple functions/arguments, the argument may also be documented by
  ## appending ##<< comments on the same line as the argument. For those who
  ## wish to become confused, any following ### comment lines will be appended.
  arg.pat <- "^\\s*\\(?\\s*([\\w\\.]+).*##<<\\s*(\\S.*?)\\s*$"
  for ( k in 2:length(code) ){
    if ( 0 < length(grep(arg.pat,code[k],perl=TRUE)) ){
      arg <- gsub(arg.pat,"\\\\item\\{\\1\\}",code[k],perl=TRUE)
      comment <- gsub(arg.pat,"\\2",code[k],perl=TRUE);
      res[[arg]] <-
        if ( is.null(res[[arg]]) )comment
        else paste(comment,res[[arg]],sep=" ")
    }
  }

  skeleton.fields <- c("alias","details","keyword","references","author",
                       "note","seealso","value")
  ##details<<
  ## Additionally, contiguous sections of ## comment lines beginning with
  ## xxx<< (where xxx is one of the "other" fields: alias, details, keyword,
  ## references, author, note, seealso or value) are accumulated and inserted in
  ## the relevant part of the .Rd file.
  ##
  ## In the case of value, the extra information is appended to that from
  ## any final ### comment lines.

  ## but this should not appear, because separated by a blank line
  extra.regexp <- paste("^\\s*##<<(",paste(skeleton.fields,collapse="|"),
                        ")\\s*(.*)$",sep="")
  starts.extra <- grep(extra.regexp,code,perl=TRUE)
  cont.re <- "^\\s*##\\s*";
  for ( start in starts.extra ){
    line <- code[start]
    field <- gsub(extra.regexp,"\\1",line,perl=TRUE)
    payload <- gsub(extra.regexp,"\\2",line,perl=TRUE)
    if ( start < length(code) ){
      for ( k in (start+1):length(code) ){
        if ( k %in% starts.extra        # go on to next extra section
            || 0 == length(grep(cont.re,code[k])) ){ # blank line or code ends
          if ( "alias" == field ){
            ##note<< Alias extras are automatically split at new lines.
            payload <- gsub("\\n+",paste("\\}\n\\",field,"\\{",sep=""),
                            payload,perl=TRUE)
          } else if ("keyword" == field ){
            ##keyword<< documentation utilities
            ##note<< Keyword extras are auto-split at white space.
            payload <- gsub("\\s+",paste("\\}\n\\",field,"\\{",sep=""),
                            payload,perl=TRUE)
          }
          ##details<< Each separate extra section appears as a new paragraph
          ## except that empty sections (no matter how many lines) are ignored.
          if ( 0 == length(grep("^\\s*$",payload,perl=TRUE)) )
            res[[field]] <-
              if ( is.null(res[[field]]) )payload
              else res[[field]] <- paste(res[[field]], payload, sep="\n\n")
          break;
        } else {
          payload <- paste(payload,sub(cont.re,"",code[k],perl=TRUE),sep="\n")
        }
      }
    }
  }
  res
### Named list of character strings extracted from comments. For each
### name N we will look for N\{...\} in the Rd file and replace it
### with the string in this list (implemented in modify.Rd.file).
}

.result <- list(
  decomment = list(
    format="",
    title="decomment",
    description = "Remove comment \\code{\\link{prefix}} and join lines of code to form a
documentation string. We use \\code{\\link[base]{gsub}} and \\code{\\link[base]{paste}}.",
    `item{comments}` = "Character vector of prefixed comment lines.",
    value = "String without prefixes or newlines."),
  empty.description = list(
    format="",
    title="empty description",
    description = "Default DESCRIPTION, written if it doesn't exist."),
  extract.docs.file = list(
    title = "Extract documentation from a file",
    format="",
    description = "Parse an R code file and extract inline documentation from\ncomments around each function.",
    `item{code.file}` = "The R code file to parse.", `item{write.examples}` = "Gather examples from test files?",
    value = "named list of lists. Each element is the result of a call to\n\\code{\\link{extract.docs.fun}}, with names corresponding to functions found in\nthe R code file."),
  extract.docs.fun = list(
    format="",
    title = "Extract documentation from a function", description = "Given a function, return a list describing inline documentation in\nthe source of that function (relies on source attr).",
    `item{fun}` = "The function to examine.", value = "Named list of character strings extracted from comments. For each\nname N we will look for N\\{...\\} in the Rd file and replace it\nwith the string in this list (implemented in \\code{\\link{modify.Rd.file}}).",
    details = "For simple functions/arguments, the argument may also be documented by\nappending ##<< comments on the same line as the argument. For those who\nwish to become confused, any following ### comment lines will be appended.\n\nAdditionally, contiguous sections of ## comment lines beginning with\nxxx<< (where xxx is one of the \"other\" fields: alias, details, keyword,\nreferences, author, note, seealso or value) are accumulated and inserted in\nthe relevant part of the .Rd file.\n\nIn the case of value, the extra information is appended to that from\nany final ### comment lines.\n\nEach separate extra section appears as a new paragraph\nexcept that empty sections (no matter how many lines) are ignored.",
    note = "Alias extras are automatically split at new lines.\n\nKeyword extras are auto-split at white space.",
    keyword = "documentation}\n\\keyword{utilities"),
  desc.fields = list(
    format="",
    title="desc fields",
    description = "Necessary fields in DESCRIPTION, otherwise error."),
modify.Rd.file = list(
    examples="\ncat(\"\\\\\")\n",
    description = "Add inline documentation from comments to an Rd file\nautomatically-generated by package.skeleton.",
    format="",
    title="modify Rd file",
    `item{N}` = "Name of function/file to which we will add documentation.",
    `item{pkg}` = "Package name.", `item{docs}` = "Named list of documentation in extracted comments."),
  package.skeleton.dx = list(
    format="",
    title = "Package skeleton deluxe", description = "Automates more of the setup process for a new source\npackage. After inspecting the specified R code files to find\ninline documentation, it calls the standard package.skeleton\nfunction, which creates bare Rd files. The inline documentation is\nadded to these Rd files and then these files are copied to\n../man. It will overwrite files in the pkgdir/man directory.",
    `item{pkgdir}` = "package directory where the DESCRIPTION file lives. Your code\nshould be in pkgdir/R. We will setwd to pkgdir/R for the duration\nof the function, then switch back to where you were previously.",
    `item{code_files}` = "Character vector with the names of the R code files, to be passed\nto package.skeleton, and also inspected for inline\ndocumentation. NULL means all files ending in .R.",
    `item{check.type}` = "Value indicating whether or not to check the package after\ndocumentation is built. Anything other than \"\" (the default) will\ncheck the package. \"noex\" means check the package without running\nexamples, only tests (useful for debugging if your tests/examples\ntake a long time)."),
  prefix = list(
    description = "Prefix for code comments used with grep and gsub.",
    format="",
    title="prefix"))

