### 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.
(comments ##<< Character vector of prefixed comment lines.
 ){
  paste(gsub(prefix,"",comments),collapse=" ")
### String without prefixes or newlines.
}

### Necessary fields in DESCRIPTION, otherwise error.
fields <- c("Package","Maintainer","Author","Version",
            "License","Title","Description")
### Default DESCRIPTION, written if it doesn't exist.
empty.description <- matrix("",ncol=length(fields),dimnames=list(NULL,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=""
### 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 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"]
  in.details <- setdiff(colnames(desc),"Description")
  details <- paste(paste(in.details,": \\tab ",desc[,in.details],"\\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,rec=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'),"..",rec=TRUE)
  unlink(name,rec=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 <- 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{}")
  if ( "\\keyword" %in% names(d) ){
    dlines <- c(dlines,"\\keyword{}\n")
  }
  ## 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")
}

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("^[\\s(]*","",code[start-1],perl=TRUE)
      arg <- gsub("^([\\w\\.]+).*","\\1",arg,perl=TRUE)
      arg <- gsub("...","\\dots",arg,fix=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);
      if ( is.null(res[[arg]]) ){
        res[[arg]] <- comment
      } else {
        res[[arg]] <- 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 ){
            ##<<alias souped up function extraction
            ## extended keyword function commenting
            ##<<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)) ){
            if ( is.null(res[[field]]) ){
              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).
}

