Modified Rweave driver and functions to use minted

mintedSweave.R

RweaveLatexMinted <- function()
{
    list(setup = RweaveLatexSetup,
         runcode = RweaveLatexRuncodeMinted,
         writedoc = RweaveLatexWritedocMinted,
         finish = RweaveLatexFinish,
         checkopts = RweaveLatexOptions)
}

makeRweaveLatexCodeRunnerMinted <- function(evalFunc=RweaveEvalWithOpt)
{
    ## Return a function suitable as the 'runcode' element
    ## of an Sweave driver.  evalFunc will be used for the
    ## actual evaluation of chunk code.
    RweaveLatexRuncode <- function(object, chunk, options) {
        if (!(options$engine %in% c("R", "S"))){
            return(object)
        }

        if (!object$quiet){
            cat(formatC(options$chunknr, width=2), ":")
            if (options$echo) cat(" echo")
            if (options$keep.source) cat(" keep.source")
            if (options$eval){
                if (options$print) cat(" print")
                if (options$term) cat(" term")
                cat("", options$results)
                if (options$fig){
                    if (options$eps) cat(" eps")
                    if (options$pdf) cat(" pdf")
                }
            }
            if (!is.null(options$label))
                cat(" (label=", options$label, ")", sep="")
            cat("\n")
        }

        chunkprefix <- RweaveChunkPrefix(options)

        if(options$split){
            ## [x][[1L]] avoids partial matching of x
            chunkout <- object$chunkout[chunkprefix][[1L]]
            if(is.null(chunkout)){
              chunkout <- file(paste(chunkprefix, "tex", sep="."), "w")
              if(!is.null(options$label))
                object$chunkout[[chunkprefix]] <- chunkout
            }
        } else {
            chunkout <- object$output
        }
        srcfile <- object$srcfile
        SweaveHooks(options, run=TRUE)

        # Note that we edit the error message below, so change both
        # if you change this line:
        chunkexps <- try(parse(text=chunk, srcfile=srcfile), silent=TRUE)

        if (inherits(chunkexps, "try-error"))
            chunkexps[1L] <- sub(" parse(text = chunk, srcfile = srcfile) : \n ",
                                 "", chunkexps[1L], fixed = TRUE)
        
        Sinput.begin    = ""
        Sinput.end      = "\n"
        Soutput.begin   = ""
        Soutput.end     = "\n"
        Schunk.begin    = "\\begin{minted}{r}"
        Schunk.end      = "\n\\end{minted}\n"
                    
        RweaveTryStop(chunkexps, options)
        openSinput <- FALSE
        openSchunk <- FALSE

        if(length(chunkexps) == 0L)
            return(object)

        srclines <- attr(chunk, "srclines")
        linesout <- integer(0L)
        srcline <- srclines[1L]

        srcrefs <- attr(chunkexps, "srcref")
        lastshown <- NA
        thisline <- 0L
        chunkregexp <- "(.*)#from line#([[:digit:]]+)#"
        for(nce in seq_along(chunkexps)) {
            ce <- chunkexps[[nce]]
            if (options$keep.source && nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) {
                srcfile <- attr(srcref, "srcfile")
                showfrom <- srcref[1L]
                showto <- srcref[3L]
                refline <- srcfile$refline
                if (is.null(refline)) {
                    if (grepl(chunkregexp, srcfile$filename)) {
                        refline <- as.integer(sub(chunkregexp, "\\2", srcfile$filename))
                        srcfile$filename <- sub(chunkregexp, "\\1", srcfile$filename)
                    } else { 
                        refline <- NA
                    }
                    srcfile$refline <- refline
                }
                if (!options$expand && !is.na(refline)) 
                    showfrom <- showto <- refline
        
                if (!is.na(refline) || is.na(lastshown)) { 
                    # Did we expand a named chunk for this expression or the previous
                    # one?
                    dce <- getSrcLines(srcfile, showfrom, showto)
                    leading <- 1L
                    if (!is.na(refline)) {
                        lastshown <- NA
                    } else {
                        lastshown <- showto
                    }
                } else {
                    dce <- getSrcLines(srcfile, lastshown+1L, showto)
                    leading <- showfrom-lastshown
                    lastshown <- showto
                }
                srcline <- showto
                while (length(dce) && length(grep("^[[:blank:]]*$", dce[1L]))) {
                    dce <- dce[-1L]
                    leading <- leading - 1L
                }
            } else {
                dce <- deparse(ce, width.cutoff=0.75*getOption("width"))
                leading <- 1L
            }
            if(object$debug)
                cat("\nRnw> ", paste(dce, collapse="\n+  "),"\n")
            if(options$echo && length(dce)){
                if(!openSinput){
                    if(!openSchunk){
                        cat(Schunk.begin, file=chunkout, append=TRUE)
                        linesout[thisline + 1L] <- srcline
                        thisline <- thisline + 1L
                        openSchunk <- TRUE
                    }
                    cat(Sinput.begin, file=chunkout, append=TRUE)
                    openSinput <- TRUE
                }
                cat("\n", paste(getOption("prompt"), dce[1L:leading], sep="", collapse="\n"),
                    file=chunkout, append=TRUE, sep="")
                if (length(dce) > leading)
                    cat("\n", paste(getOption("continue"), dce[-(1L:leading)], sep="", collapse="\n"),
                        file=chunkout, append=TRUE, sep="")
                linesout[thisline + seq_along(dce)] <- srcline
                thisline <- thisline + length(dce)
            }

            # tmpcon <- textConnection("output", "w")
            # avoid the limitations (and overhead) of output text connections
            tmpcon <- file()
            sink(file=tmpcon)
            err <- NULL
            if(options$eval) err <- evalFunc(ce, options)
            cat("\n") # make sure final line is complete
            sink()
            output <- readLines(tmpcon)
            close(tmpcon)
            ## delete empty output
            if(length(output) == 1L & output[1L] == "") output <- NULL

            RweaveTryStop(err, options)

            if(object$debug)
                cat(paste(output, collapse="\n"))

            if(length(output) & (options$results != "hide")){

                if(openSinput){
                    cat(Sinput.end, file=chunkout, append=TRUE)
                    linesout[thisline + 1L:2L] <- srcline
                    thisline <- thisline + 2L
                    openSinput <- FALSE
                }
                if(options$results=="verbatim"){
                    if(!openSchunk){
                        cat(Schunk.begin, file=chunkout, append=TRUE)
                        linesout[thisline + 1L] <- srcline
                        thisline <- thisline + 1L
                        openSchunk <- TRUE
                    }
                    cat(Soutput.begin, file=chunkout, append=TRUE)
                    linesout[thisline + 1L] <- srcline
                    thisline <- thisline + 1L
                }

                output <- paste(output,collapse="\n")
                if(options$strip.white %in% c("all", "true")){
                    output <- sub("^[[:space:]]*\n", "", output)
                    output <- sub("\n[[:space:]]*$", "", output)
                    if(options$strip.white=="all")
                          output <- sub("\n[[:space:]]*\n", "\n", output)
                }
                cat(output, file=chunkout, append=TRUE)
                count <- sum(strsplit(output, NULL)[[1L]] == "\n")
                if (count > 0L) {
                    linesout[thisline + 1L:count] <- srcline
                    thisline <- thisline + count
                }

                remove(output)

                if(options$results=="verbatim"){
                    cat(Soutput.end, file=chunkout, append=TRUE)
                    linesout[thisline + 1L:2L] <- srcline
                    thisline <- thisline + 2L
                }
            }
        }

        if(openSinput){
            cat(Sinput.end, file=chunkout, append=TRUE)
            linesout[thisline + 1L:2L] <- srcline
            thisline <- thisline + 2L
        }

        if(openSchunk){
          cat(Schunk.end, file=chunkout, append=TRUE)
          linesout[thisline + 1L] <- srcline
          thisline <- thisline + 1L
        }

        if(is.null(options$label) & options$split)
            close(chunkout)

        if(options$split & options$include){
            cat("\\input{", chunkprefix, "}\n", sep="", file=object$output, append=TRUE)
            linesout[thisline + 1L] <- srcline
            thisline <- thisline + 1L
        }

        if(options$fig && options$eval){
            if(options$eps){
                grDevices::postscript(file=paste(chunkprefix, "eps", sep="."),
                                      width=options$width, height=options$height,
                                      paper="special", horizontal=FALSE)

                err <- try({SweaveHooks(options, run=TRUE)
                            eval(chunkexps, envir=.GlobalEnv)})
                grDevices::dev.off()
                if(inherits(err, "try-error")) stop(err)
            }
            if(options$pdf){
                grDevices::pdf( file=paste(chunkprefix, "pdf", sep="."),
                                width=options$width, height=options$height,
                                version=options$pdf.version,
                                encoding=options$pdf.encoding)

                err <- try({SweaveHooks(options, run=TRUE)
                          eval(chunkexps, envir=.GlobalEnv)})
                grDevices::dev.off()
                if(inherits(err, "try-error")) stop(err)
            }
            if(options$include) {
                cat("\\begin{center} \\includegraphics{", chunkprefix, "}\n \\end{center}\n", sep="",
                    file=object$output, append=TRUE)
                linesout[thisline + 1L] <- srcline
                thisline <- thisline + 1L
            }
        }
        object$linesout <- c(object$linesout, linesout)
        return(object)
    }
    RweaveLatexRuncode
}

RweaveLatexRuncodeMinted <- makeRweaveLatexCodeRunnerMinted()

RweaveLatexWritedocMinted <- function(object, chunk) {
    linesout <- attr(chunk, "srclines")

    if(length(grep("\\usepackage[^\\}]*Sweave.*\\}", chunk)))
        object$havesty <- TRUE



    if(!object$havesty){
        begindoc <- "^[[:space:]]*\\\\begin\\{document\\}"
        which <- grep(begindoc, chunk)
        
        repstr = paste("\\\\usepackage{",object$styfile,"}\n\n",
                       "\\\\begin{document}", sep="")
        
        if(length(grep("\\usepackage\\{minted\\}", chunk)) == 0){
            repstr = paste("\\\\usepackage{minted}\n\n", repstr,sep="")
        }
        
        if (length(which)) {
            chunk[which] <- sub(begindoc,
                                repstr,
                                chunk[which])
            linesout <- linesout[c(1L:which, which, seq(from=which+1L, length.out=length(linesout)-which))]
            object$havesty <- TRUE
        }
    }




    while(length(pos <- grep(object$syntax$docexpr, chunk))) {
        cmdloc <- regexpr(object$syntax$docexpr, chunk[pos[1L]])
        cmd <- substr(chunk[pos[1L]], cmdloc,
                      cmdloc+attr(cmdloc, "match.length")-1L)
        cmd <- sub(object$syntax$docexpr, "\\1", cmd)
        if(object$options$eval){
            val <- as.character(eval(parse(text=cmd), envir=.GlobalEnv))
            ## protect against character(0L), because sub() will fail
            if(length(val) == 0L) val <- ""
        }
        else
            val <- paste("\\\\verb{<<", cmd, ">>{", sep="")

        chunk[pos[1L]] <- sub(object$syntax$docexpr, val, chunk[pos[1L]])
    }
    while(length(pos <- grep(object$syntax$docopt, chunk))) {
        opts <- sub(paste(".*", object$syntax$docopt, ".*", sep=""),
                    "\\1", chunk[pos[1L]])
        object$options <- SweaveParseOptions(opts, object$options,
                                             RweaveLatexOptions)
        if (isTRUE(object$options$concordance) && !object$haveconcordance) {
            savelabel <- object$options$label
            object$options$label <- "concordance"
            prefix <- RweaveChunkPrefix(object$options)
            object$options$label <- savelabel
            object$concordfile <- paste(prefix, "tex", sep=".")
            chunk[pos[1L]] <- sub(object$syntax$docopt,
                                 paste("\\\\input{", prefix, "}", sep=""),
                                 chunk[pos[1L]])
            object$haveconcordance <- TRUE
        } else {
            chunk[pos[1L]] <- sub(object$syntax$docopt, "", chunk[pos[1L]])
        }
    }

    cat(chunk, sep="\n", file=object$output, append=TRUE)
    object$linesout <- c(object$linesout, linesout)

    return(object)
}