.packageName <- "ascii"
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/RweaveAsciidoc.r"
RweaveAsciidoc <- function()
{
    list(setup = RweaveAsciidocSetup,
         runcode = RweaveAsciidocRuncode,
         writedoc = RweaveAsciidocWritedoc,
         finish = RweaveAsciidocFinish,
         checkopts = RweaveAsciidocOptions)
}

RweaveAsciidocSetup <-
    function(file, syntax, output=NULL, quiet=FALSE, debug=FALSE,
             stylepath, ...)
{
    dots <- list(...)
    if(is.null(output)) {
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "txt", sep=".")
    } else prefix.string <- basename(sub("\\.txt$", "", output))

    if(!quiet) cat("Writing to file ", output, "\n",
                   "Processing code chunks ...\n", sep="")
    output <- file(output, open="w+")

    options <- list(prefix=TRUE, prefix.string=prefix.string,
                    engine="R", print=FALSE, eval=TRUE,
                    fig=FALSE, ext = "jpg", png=FALSE, jpg=TRUE, pdf=TRUE, eps=FALSE,
                    width=6, height=6, res=100, term=TRUE,
                    echo=TRUE, keep.source=FALSE, results="verbatim",
                    split=FALSE, strip.white="true", include=TRUE,
                    pdf.version=grDevices::pdf.options()$version,
                    pdf.encoding=grDevices::pdf.options()$encoding,
                    concordance=FALSE, expand=TRUE)
    options[names(dots)] <- dots

    ## to be on the safe side: see if defaults pass the check
    options <- RweaveAsciidocOptions(options)

    list(output=output, 
         debug=debug, quiet=quiet, syntax = syntax,
         options=options, chunkout=list(), srclines=integer(0L),
         srcfile=srcfile(file))
}

makeRweaveAsciidocCodeRunner <- 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.
    RweaveAsciidocRuncode <- 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$png) cat(" png")
                      if(options$jpg) cat(" jpg")
                      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, "txt", sep="."), "w")
                  if(!is.null(options$label))
                    object$chunkout[[chunkprefix]] <- chunkout
              }
          }
          else
            chunkout <- object$output

      saveopts <- options(keep.source=options$keep.source)
      on.exit(options(saveopts))

          SweaveHooks(options, run=TRUE)

          chunkexps <- try(parse(text=chunk), silent=TRUE)
          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")
      if (options$expand)
        lastshown <- 0L
      else
        lastshown <- srcline - 1L
      thisline <- 0
          for(nce in 1L:length(chunkexps))
            {
                ce <- chunkexps[[nce]]
                if (nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) {
                    if (options$expand) {
                    srcfile <- attr(srcref, "srcfile")
                    showfrom <- srcref[1L]
                    showto <- srcref[3L]
                    } else {
                        srcfile <- object$srcfile
                        showfrom <- srclines[srcref[1L]]
                        showto <- srclines[srcref[3L]]
                    }
                    dce <- getSrcLines(srcfile, lastshown+1, showto)
                leading <- showfrom-lastshown
                lastshown <- showto
                    srcline <- srclines[srcref[3L]]
                    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("----\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1] <- srcline
                            thisline <- thisline + 1
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        openSinput <- TRUE
                    }
            cat("", 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 + 1L:length(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("") # 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) == 0 | options$results == "hide") cat("\n", file=chunkout, append=TRUE)

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

                    if(openSinput){
                        cat("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2L] <- srcline
                        thisline <- thisline + 2L
                        openSinput <- FALSE
                    }
                    if(options$results=="verbatim"){
                        if(!openSchunk){
                            cat("----\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        linesout[thisline + 1L] <- srcline
                        thisline <- thisline + 1L
                    }
                    if(options$results=="ascii"){
                        if(openSinput){
                            cat("",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        if(openSchunk){
                            cat("----\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- FALSE
                        }
                        addabreak <- "\n"
                    }
                    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,addabreak, 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("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2] <- srcline
                        thisline <- thisline + 2L
                    }
                }
            }

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

          if(openSchunk){
              cat("----\n", 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("include::", chunkprefix, ".txt[]\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$png){
                  png(file=paste(chunkprefix, "png", sep="."),width=options$width,height=options$height,units="in",res=options$res)

                  err <- try({SweaveHooks(options, run=TRUE);
                        eval(chunkexps, envir=.GlobalEnv)})
                  dev.off()
                  if(inherits(err, "try-error")) stop(err)
              }
              if(options$jpg){
                  jpeg(file=paste(chunkprefix, "jpg", sep="."),width=options$width,height=options$height,quality=100,units="in",res=options$res)

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

RweaveAsciidocRuncode <- makeRweaveAsciidocCodeRunner()

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

    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="") # Mais qu'est-ce ??

        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 <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveAsciidocOptions)
            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)
}

RweaveAsciidocFinish <- function(object, error=FALSE)
{
    outputname <- summary(object$output)$description
    inputname <- object$srcfile$filename
    if(!object$quiet && !error)
        cat("\n",
            gettextf("You can now run asciidoc on '%s'", outputname),
            "\n", sep = "")
    close(object$output)
    if(length(object$chunkout))
        for(con in object$chunkout) close(con)
#    if (object$haveconcordance) {
        # This output format is subject to change.  Currently it contains
        # three parts, separated by colons:
        # 1.  The output .tex filename
        # 2.  The input .Rnw filename
        # 3.  The input line numbers corresponding to each output line.
        #     This are compressed using the following simple scheme:
        #     The first line number, followed by
        #     a run-length encoded diff of the rest of the line numbers.
#        linesout <- object$linesout
#        vals <- rle(diff(linesout))
#        vals <- c(linesout[1L], as.numeric(rbind(vals$lengths, vals$values)))
#        concordance <- paste(strwrap(paste(vals, collapse=" ")), collapse=" %\n")
#        special <- paste("\\Sconcordance{concordance:", outputname, ":", inputname, ":%\n",
#                 concordance,"}\n", sep="")
#        cat(special, file=object$concordfile)
#    }
    invisible(outputname)
}

RweaveAsciidocOptions <- function(options)
{

    ## ATTENTION: Changes in this function have to be reflected in the
    ## defaults in the init function!

    ## convert a character string to logical
    c2l <- function(x){
        if(is.null(x)) return(FALSE)
        else return(as.logical(toupper(as.character(x))))
    }

    NUMOPTS <- c("width", "height", "res")
    NOLOGOPTS <- c(NUMOPTS, "ext", "results", "prefix.string",
                   "engine", "label", "strip.white",
                   "pdf.version", "pdf.encoding", "pointsize")

    for(opt in names(options)){
        if(! (opt %in% NOLOGOPTS)){
            oldval <- options[[opt]]
            if(!is.logical(options[[opt]])){
                options[[opt]] <- c2l(options[[opt]])
            }
            if(is.na(options[[opt]]))
                stop(gettextf("invalid value for '%s' : %s", opt, oldval),
                     domain = NA)
        }
        else if(opt %in% NUMOPTS){
            options[[opt]] <- as.numeric(options[[opt]])
        }
    }

    if(!is.null(options$results))
        options$results <- tolower(as.character(options$results))
    options$results <- match.arg(options$results,
                                 c("verbatim", "ascii", "hide"))

    if(!is.null(options$strip.white))
        options$strip.white <- tolower(as.character(options$strip.white))
    options$strip.white <- match.arg(options$strip.white,
                                     c("true", "false", "all"))

    options
}


RweaveChunkPrefix <- function(options)
{
    if(!is.null(options$label)){
        if(options$prefix)
            chunkprefix <- paste(options$prefix.string, "-",
                                 options$label, sep="")
        else
            chunkprefix <- options$label
    }
    else
        chunkprefix <- paste(options$prefix.string, "-",
                             formatC(options$chunknr, flag="0", width=3),
                             sep="")

    return(chunkprefix)
}

RweaveEvalWithOpt <- function (expr, options){
    if(options$eval){
        res <- try(.Internal(eval.with.vis(expr, .GlobalEnv, baseenv())),
                   silent=TRUE)
        if(inherits(res, "try-error")) return(res)
        if(options$print | (options$term & res$visible))
            print(res$value)
    }
    return(res)
}


RweaveTryStop <- function(err, options){

    if(inherits(err, "try-error")){
        cat("\n")
        msg <- paste(" chunk", options$chunknr)
        if(!is.null(options$label))
            msg <- paste(msg, " (label=", options$label, ")", sep="")
        msg <- paste(msg, "\n")
        stop(msg, err, call.=FALSE)
    }
}





###**********************************************************

Stangle <- function(file, driver=Rtangle(),
                    syntax=getOption("SweaveSyntax"), ...)
{
    Sweave(file=file, driver=driver, ...)
}

RtangleAsciidoc <-  function()
{
    list(setup = RtangleAsciidocSetup,
         runcode = RtangleAsciidocRuncode,
         writedoc = RtangleAsciidocWritedoc,
         finish = RtangleAsciidocFinish,
         checkopts = RweaveAsciidocOptions)
}


RtangleAsciidocSetup <- function(file, syntax,
                         output=NULL, annotate=TRUE, split=FALSE,
                         prefix=TRUE, quiet=FALSE)
{
    if(is.null(output)){
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "R", sep=".")
    }
    else{
        prefix.string <- basename(sub("\\.[rsRS]$", "", output))
    }

    if(!split){
        if(!quiet)
            cat("Writing to file", output, "\n")
        output <- file(output, open="w")
    }
    else{
        if(!quiet)
            cat("Writing chunks to files ...\n")
        output <- NULL
    }

    options <- list(split=split, prefix=prefix,
                    prefix.string=prefix.string,
                    engine="R", eval=TRUE)

    list(output=output, annotate=annotate, options=options,
         chunkout=list(), quiet=quiet, syntax=syntax)
}


RtangleAsciidocRuncode <-  function(object, chunk, options)
{
    if(!(options$engine %in% c("R", "S"))){
        return(object)
    }

    chunkprefix <- RweaveChunkPrefix(options)

    if(options$split){
        outfile <- paste(chunkprefix, options$engine, sep=".")
        if(!object$quiet)
            cat(options$chunknr, ":", outfile,"\n")
        ## [x][[1L]] avoids partial matching of x
        chunkout <- object$chunkout[chunkprefix][[1L]]
        if(is.null(chunkout)){
            chunkout <- file(outfile, "w")
            if(!is.null(options$label))
                object$chunkout[[chunkprefix]] <- chunkout
        }
    }
    else
        chunkout <- object$output

    if(object$annotate){
        cat("###################################################\n",
            "### chunk number ", options$chunknr,
            ": ", options$label,
            ifelse(options$eval, "", " eval=FALSE"), "\n",
            "###################################################\n",
            file=chunkout, append=TRUE, sep="")
    }

    hooks <- SweaveHooks(options, run=FALSE)
    for(k in hooks)
        cat("getOption(\"SweaveHooks\")[[\"", k, "\"]]()\n",
            file=chunkout, append=TRUE, sep="")

    if(!options$eval)
        chunk <- paste("##", chunk)

    cat(chunk,"\n", file=chunkout, append=TRUE, sep="\n")

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

    return(object)
}

RtangleAsciidocWritedoc <- function(object, chunk)
{
    while(length(pos <- grep(object$syntax$docopt, chunk)))
    {
        opts <- sub(paste(".*", object$syntax$docopt, ".*", sep=""),
                    "\\1", chunk[pos[1L]])
        object$options <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveAsciidocOptions)
        chunk[pos[1L]] <- sub(object$syntax$docopt, "", chunk[pos[1L]])
    }
    return(object)
}


RtangleAsciidocFinish <- function(object, error=FALSE)
{
    if(!is.null(object$output))
        close(object$output)

    if(length(object$chunkout)) {
        for(con in object$chunkout) close(con)
    }
}


#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/RweaveOrg.r"
RweaveOrg <- function()
{
    list(setup = RweaveOrgSetup,
         runcode = RweaveOrgRuncode,
         writedoc = RweaveOrgWritedoc,
         finish = RweaveOrgFinish,
         checkopts = RweaveOrgOptions)
}

RweaveOrgSetup <-
    function(file, syntax, output=NULL, quiet=FALSE, debug=FALSE,
             stylepath, ...)
{
    dots <- list(...)
    if(is.null(output)) {
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "org", sep=".")
    } else prefix.string <- basename(sub("\\.org$", "", output))

    if(!quiet) cat("Writing to file ", output, "\n",
                   "Processing code chunks ...\n", sep="")
    output <- file(output, open="w+")

    options <- list(prefix=TRUE, prefix.string=prefix.string,
                    engine="R", print=FALSE, eval=TRUE,
                    fig=FALSE, ext = "jpg", png=FALSE, jpg=TRUE, pdf=TRUE, eps=FALSE,
                    width=6, height=6, res=100, term=TRUE,
                    echo=TRUE, keep.source=FALSE, results="verbatim",
                    split=FALSE, strip.white="true", include=TRUE,
                    pdf.version=grDevices::pdf.options()$version,
                    pdf.encoding=grDevices::pdf.options()$encoding,
                    concordance=FALSE, expand=TRUE)
    options[names(dots)] <- dots

    ## to be on the safe side: see if defaults pass the check
    options <- RweaveOrgOptions(options)

    list(output=output, 
         debug=debug, quiet=quiet, syntax = syntax,
         options=options, chunkout=list(), srclines=integer(0L),
         srcfile=srcfile(file))
}

makeRweaveOrgCodeRunner <- 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.
    RweaveOrgRuncode <- 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$png) cat(" png")
                      if(options$jpg) cat(" jpg")
                      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, "org", sep="."), "w")
                  if(!is.null(options$label))
                    object$chunkout[[chunkprefix]] <- chunkout
              }
          }
          else
            chunkout <- object$output

      saveopts <- options(keep.source=options$keep.source)
      on.exit(options(saveopts))

          SweaveHooks(options, run=TRUE)

          chunkexps <- try(parse(text=chunk), silent=TRUE)
          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")
      if (options$expand)
        lastshown <- 0L
      else
        lastshown <- srcline - 1L
      thisline <- 0
          for(nce in 1L:length(chunkexps))
            {
                ce <- chunkexps[[nce]]
                if (nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) {
                    if (options$expand) {
                    srcfile <- attr(srcref, "srcfile")
                    showfrom <- srcref[1L]
                    showto <- srcref[3L]
                    } else {
                        srcfile <- object$srcfile
                        showfrom <- srclines[srcref[1L]]
                        showto <- srclines[srcref[3L]]
                    }
                    dce <- getSrcLines(srcfile, lastshown+1, showto)
                leading <- showfrom-lastshown
                lastshown <- showto
                    srcline <- srclines[srcref[3L]]
                    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("#+BEGIN_SRC R-transcript\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1] <- srcline
                            thisline <- thisline + 1
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        openSinput <- TRUE
                    }
            cat("", 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 + 1L:length(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("") # 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) == 0 | options$results == "hide") cat("\n", file=chunkout, append=TRUE)

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

                    if(openSinput){
                        cat("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2L] <- srcline
                        thisline <- thisline + 2L
                        openSinput <- FALSE
                    }
                    if(options$results=="verbatim"){
                        if(!openSchunk){
                            cat("#+BEGIN_SRC R-transcript\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        linesout[thisline + 1L] <- srcline
                        thisline <- thisline + 1L
                    }
                    if(options$results=="ascii"){
                        if(openSinput){
                            cat("",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        if(openSchunk){
                            cat("#+END_SRC\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- FALSE
                        }
                        addabreak <- "\n"
                    }
                    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,addabreak, 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("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2] <- srcline
                        thisline <- thisline + 2L
                    }
                }
            }

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

          if(openSchunk){
              cat("#+END_SRC\n", 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("#+INCLUDE: \"", chunkprefix, ".org\"\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$png){
                  png(file=paste(chunkprefix, "png", sep="."),width=options$width,height=options$height,units="in",res=options$res)

                  err <- try({SweaveHooks(options, run=TRUE);
                        eval(chunkexps, envir=.GlobalEnv)})
                  dev.off()
                  if(inherits(err, "try-error")) stop(err)
              }
              if(options$jpg){
                  jpeg(file=paste(chunkprefix, "jpg", sep="."),width=options$width,height=options$height,quality=100,units="in",res=options$res)

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

RweaveOrgRuncode <- makeRweaveOrgCodeRunner()

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

    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="") # Mais qu'est-ce ??

        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 <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveOrgOptions)
            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)
}

RweaveOrgFinish <- function(object, error=FALSE)
{
    outputname <- summary(object$output)$description
    inputname <- object$srcfile$filename
    if(!object$quiet && !error)
        cat("\n",
            gettextf("You can now use org-mode on '%s'", outputname),
            "\n", sep = "")
    close(object$output)
    if(length(object$chunkout))
        for(con in object$chunkout) close(con)
#    if (object$haveconcordance) {
        # This output format is subject to change.  Currently it contains
        # three parts, separated by colons:
        # 1.  The output .tex filename
        # 2.  The input .Rnw filename
        # 3.  The input line numbers corresponding to each output line.
        #     This are compressed using the following simple scheme:
        #     The first line number, followed by
        #     a run-length encoded diff of the rest of the line numbers.
#        linesout <- object$linesout
#        vals <- rle(diff(linesout))
#        vals <- c(linesout[1L], as.numeric(rbind(vals$lengths, vals$values)))
#        concordance <- paste(strwrap(paste(vals, collapse=" ")), collapse=" %\n")
#        special <- paste("\\Sconcordance{concordance:", outputname, ":", inputname, ":%\n",
#                 concordance,"}\n", sep="")
#        cat(special, file=object$concordfile)
#    }
    invisible(outputname)
}

RweaveOrgOptions <- function(options)
{

    ## ATTENTION: Changes in this function have to be reflected in the
    ## defaults in the init function!

    ## convert a character string to logical
    c2l <- function(x){
        if(is.null(x)) return(FALSE)
        else return(as.logical(toupper(as.character(x))))
    }

    NUMOPTS <- c("width", "height", "res")
    NOLOGOPTS <- c(NUMOPTS, "ext", "results", "prefix.string",
                   "engine", "label", "strip.white",
                   "pdf.version", "pdf.encoding", "pointsize")

    for(opt in names(options)){
        if(! (opt %in% NOLOGOPTS)){
            oldval <- options[[opt]]
            if(!is.logical(options[[opt]])){
                options[[opt]] <- c2l(options[[opt]])
            }
            if(is.na(options[[opt]]))
                stop(gettextf("invalid value for '%s' : %s", opt, oldval),
                     domain = NA)
        }
        else if(opt %in% NUMOPTS){
            options[[opt]] <- as.numeric(options[[opt]])
        }
    }

    if(!is.null(options$results))
        options$results <- tolower(as.character(options$results))
    options$results <- match.arg(options$results,
                                 c("verbatim", "ascii", "hide"))

    if(!is.null(options$strip.white))
        options$strip.white <- tolower(as.character(options$strip.white))
    options$strip.white <- match.arg(options$strip.white,
                                     c("true", "false", "all"))

    options
}


RweaveChunkPrefix <- function(options)
{
    if(!is.null(options$label)){
        if(options$prefix)
            chunkprefix <- paste(options$prefix.string, "-",
                                 options$label, sep="")
        else
            chunkprefix <- options$label
    }
    else
        chunkprefix <- paste(options$prefix.string, "-",
                             formatC(options$chunknr, flag="0", width=3),
                             sep="")

    return(chunkprefix)
}

RweaveEvalWithOpt <- function (expr, options){
    if(options$eval){
        res <- try(.Internal(eval.with.vis(expr, .GlobalEnv, baseenv())),
                   silent=TRUE)
        if(inherits(res, "try-error")) return(res)
        if(options$print | (options$term & res$visible))
            print(res$value)
    }
    return(res)
}


RweaveTryStop <- function(err, options){

    if(inherits(err, "try-error")){
        cat("\n")
        msg <- paste(" chunk", options$chunknr)
        if(!is.null(options$label))
            msg <- paste(msg, " (label=", options$label, ")", sep="")
        msg <- paste(msg, "\n")
        stop(msg, err, call.=FALSE)
    }
}





###**********************************************************

Stangle <- function(file, driver=Rtangle(),
                    syntax=getOption("SweaveSyntax"), ...)
{
    Sweave(file=file, driver=driver, ...)
}

RtangleOrg <-  function()
{
    list(setup = RtangleOrgSetup,
         runcode = RtangleOrgRuncode,
         writedoc = RtangleOrgWritedoc,
         finish = RtangleOrgFinish,
         checkopts = RweaveOrgOptions)
}


RtangleOrgSetup <- function(file, syntax,
                         output=NULL, annotate=TRUE, split=FALSE,
                         prefix=TRUE, quiet=FALSE)
{
    if(is.null(output)){
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "R", sep=".")
    }
    else{
        prefix.string <- basename(sub("\\.[rsRS]$", "", output))
    }

    if(!split){
        if(!quiet)
            cat("Writing to file", output, "\n")
        output <- file(output, open="w")
    }
    else{
        if(!quiet)
            cat("Writing chunks to files ...\n")
        output <- NULL
    }

    options <- list(split=split, prefix=prefix,
                    prefix.string=prefix.string,
                    engine="R", eval=TRUE)

    list(output=output, annotate=annotate, options=options,
         chunkout=list(), quiet=quiet, syntax=syntax)
}


RtangleOrgRuncode <-  function(object, chunk, options)
{
    if(!(options$engine %in% c("R", "S"))){
        return(object)
    }

    chunkprefix <- RweaveChunkPrefix(options)

    if(options$split){
        outfile <- paste(chunkprefix, options$engine, sep=".")
        if(!object$quiet)
            cat(options$chunknr, ":", outfile,"\n")
        ## [x][[1L]] avoids partial matching of x
        chunkout <- object$chunkout[chunkprefix][[1L]]
        if(is.null(chunkout)){
            chunkout <- file(outfile, "w")
            if(!is.null(options$label))
                object$chunkout[[chunkprefix]] <- chunkout
        }
    }
    else
        chunkout <- object$output

    if(object$annotate){
        cat("###################################################\n",
            "### chunk number ", options$chunknr,
            ": ", options$label,
            ifelse(options$eval, "", " eval=FALSE"), "\n",
            "###################################################\n",
            file=chunkout, append=TRUE, sep="")
    }

    hooks <- SweaveHooks(options, run=FALSE)
    for(k in hooks)
        cat("getOption(\"SweaveHooks\")[[\"", k, "\"]]()\n",
            file=chunkout, append=TRUE, sep="")

    if(!options$eval)
        chunk <- paste("##", chunk)

    cat(chunk,"\n", file=chunkout, append=TRUE, sep="\n")

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

    return(object)
}

RtangleOrgWritedoc <- function(object, chunk)
{
    while(length(pos <- grep(object$syntax$docopt, chunk)))
    {
        opts <- sub(paste(".*", object$syntax$docopt, ".*", sep=""),
                    "\\1", chunk[pos[1L]])
        object$options <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveOrgOptions)
        chunk[pos[1L]] <- sub(object$syntax$docopt, "", chunk[pos[1L]])
    }
    return(object)
}


RtangleOrgFinish <- function(object, error=FALSE)
{
    if(!is.null(object$output))
        close(object$output)

    if(length(object$chunkout)) {
        for(con in object$chunkout) close(con)
    }
}


#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/RweaveReST.r"
RweaveReST <- function()
{
    list(setup = RweaveReSTSetup,
         runcode = RweaveReSTRuncode,
         writedoc = RweaveReSTWritedoc,
         finish = RweaveReSTFinish,
         checkopts = RweaveReSTOptions)
}

RweaveReSTSetup <-
    function(file, syntax, output=NULL, quiet=FALSE, debug=FALSE,
             stylepath, ...)
{
    dots <- list(...)
    if(is.null(output)) {
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "rst", sep=".")
    } else prefix.string <- basename(sub("\\.rst$", "", output))

    if(!quiet) cat("Writing to file ", output, "\n",
                   "Processing code chunks ...\n", sep="")
    output <- file(output, open="w+")

    options <- list(prefix=TRUE, prefix.string=prefix.string,
                    engine="R", print=FALSE, eval=TRUE,
                    fig=FALSE, ext = "jpg", png=FALSE, jpg=TRUE, pdf=TRUE, eps=FALSE,
                    width=6, height=6, res=100, term=TRUE,
                    echo=TRUE, keep.source=FALSE, results="verbatim",
                    split=FALSE, strip.white="true", include=TRUE,
                    pdf.version=grDevices::pdf.options()$version,
                    pdf.encoding=grDevices::pdf.options()$encoding,
                    concordance=FALSE, expand=TRUE)
    options[names(dots)] <- dots

    ## to be on the safe side: see if defaults pass the check
    options <- RweaveReSTOptions(options)

    list(output=output, 
         debug=debug, quiet=quiet, syntax = syntax,
         options=options, chunkout=list(), srclines=integer(0L),
         srcfile=srcfile(file))
}

makeRweaveReSTCodeRunner <- 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.
    RweaveReSTRuncode <- 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$png) cat(" png")
                      if(options$jpg) cat(" jpg")
                      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, "rst", sep="."), "w")
                  if(!is.null(options$label))
                    object$chunkout[[chunkprefix]] <- chunkout
              }
          }
          else
            chunkout <- object$output

      saveopts <- options(keep.source=options$keep.source)
      on.exit(options(saveopts))

          SweaveHooks(options, run=TRUE)

          chunkexps <- try(parse(text=chunk), silent=TRUE)
          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")
      if (options$expand)
        lastshown <- 0L
      else
        lastshown <- srcline - 1L
      thisline <- 0
          for(nce in 1L:length(chunkexps))
            {
                ce <- chunkexps[[nce]]
                if (nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) {
                    if (options$expand) {
                    srcfile <- attr(srcref, "srcfile")
                    showfrom <- srcref[1L]
                    showto <- srcref[3L]
                    } else {
                        srcfile <- object$srcfile
                        showfrom <- srclines[srcref[1L]]
                        showto <- srclines[srcref[3L]]
                    }
                    dce <- getSrcLines(srcfile, lastshown+1, showto)
                leading <- showfrom-lastshown
                lastshown <- showto
                    srcline <- srclines[srcref[3L]]
                    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(".. code-block:: r\n\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1] <- srcline
                            thisline <- thisline + 1
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        openSinput <- TRUE
                    }
            cat("", paste(paste("  ", getOption("prompt"), sep = ""), dce[1L:leading], sep="", collapse="\n"),
                file=chunkout, append=TRUE, sep="")
                    if (length(dce) > leading)
                        cat("\n", paste("  ", paste(getOption("continue"), sep = ""), dce[-(1L:leading)], sep="", collapse="\n"),
                            file=chunkout, append=TRUE, sep="")
            linesout[thisline + 1L:length(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("") # 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) == 0 | options$results == "hide") cat("\n", file=chunkout, append=TRUE)

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

                    if(openSinput){
                        cat("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2L] <- srcline
                        thisline <- thisline + 2L
                        openSinput <- FALSE
                    }
                    if(options$results=="verbatim"){
                        if(!openSchunk){
                            cat(".. code-block:: r\n\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        linesout[thisline + 1L] <- srcline
                        thisline <- thisline + 1L
                    }
                    if(options$results=="ascii"){
                        if(openSinput){
                            cat("",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        if(openSchunk){
                            cat("\n\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- FALSE
                        }
                        addabreak <- "\n"
                    }
                    if (options$results == "verbatim")
                      output <- paste("", output,collapse="\n", sep = "  ")
                    else
                      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,addabreak, 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("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2] <- srcline
                        thisline <- thisline + 2L
                    }
                }
            }

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

          if(openSchunk){
              cat("\n\n", 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(".. include::", chunkprefix, ".rst\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$png){
                  png(file=paste(chunkprefix, "png", sep="."),width=options$width,height=options$height,units="in",res=options$res)

                  err <- try({SweaveHooks(options, run=TRUE);
                        eval(chunkexps, envir=.GlobalEnv)})
                  dev.off()
                  if(inherits(err, "try-error")) stop(err)
              }
              if(options$jpg){
                  jpeg(file=paste(chunkprefix, "jpg", sep="."),width=options$width,height=options$height,quality=100,units="in",res=options$res)

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

RweaveReSTRuncode <- makeRweaveReSTCodeRunner()

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

    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="") # Mais qu'est-ce ??

        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 <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveReSTOptions)
            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)
}

RweaveReSTFinish <- function(object, error=FALSE)
{
    outputname <- summary(object$output)$description
    inputname <- object$srcfile$filename
    if(!object$quiet && !error)
        cat("\n",
            gettextf("You can now run docutils, sphinx... on '%s'", outputname),
            "\n", sep = "")
    close(object$output)
    if(length(object$chunkout))
        for(con in object$chunkout) close(con)
#    if (object$haveconcordance) {
        # This output format is subject to change.  Currently it contains
        # three parts, separated by colons:
        # 1.  The output .tex filename
        # 2.  The input .Rnw filename
        # 3.  The input line numbers corresponding to each output line.
        #     This are compressed using the following simple scheme:
        #     The first line number, followed by
        #     a run-length encoded diff of the rest of the line numbers.
#        linesout <- object$linesout
#        vals <- rle(diff(linesout))
#        vals <- c(linesout[1L], as.numeric(rbind(vals$lengths, vals$values)))
#        concordance <- paste(strwrap(paste(vals, collapse=" ")), collapse=" %\n")
#        special <- paste("\\Sconcordance{concordance:", outputname, ":", inputname, ":%\n",
#                 concordance,"}\n", sep="")
#        cat(special, file=object$concordfile)
#    }
    invisible(outputname)
}

RweaveReSTOptions <- function(options)
{

    ## ATTENTION: Changes in this function have to be reflected in the
    ## defaults in the init function!

    ## convert a character string to logical
    c2l <- function(x){
        if(is.null(x)) return(FALSE)
        else return(as.logical(toupper(as.character(x))))
    }

    NUMOPTS <- c("width", "height", "res")
    NOLOGOPTS <- c(NUMOPTS, "ext", "results", "prefix.string",
                   "engine", "label", "strip.white",
                   "pdf.version", "pdf.encoding", "pointsize")

    for(opt in names(options)){
        if(! (opt %in% NOLOGOPTS)){
            oldval <- options[[opt]]
            if(!is.logical(options[[opt]])){
                options[[opt]] <- c2l(options[[opt]])
            }
            if(is.na(options[[opt]]))
                stop(gettextf("invalid value for '%s' : %s", opt, oldval),
                     domain = NA)
        }
        else if(opt %in% NUMOPTS){
            options[[opt]] <- as.numeric(options[[opt]])
        }
    }

    if(!is.null(options$results))
        options$results <- tolower(as.character(options$results))
    options$results <- match.arg(options$results,
                                 c("verbatim", "ascii", "hide"))

    if(!is.null(options$strip.white))
        options$strip.white <- tolower(as.character(options$strip.white))
    options$strip.white <- match.arg(options$strip.white,
                                     c("true", "false", "all"))

    options
}


RweaveChunkPrefix <- function(options)
{
    if(!is.null(options$label)){
        if(options$prefix)
            chunkprefix <- paste(options$prefix.string, "-",
                                 options$label, sep="")
        else
            chunkprefix <- options$label
    }
    else
        chunkprefix <- paste(options$prefix.string, "-",
                             formatC(options$chunknr, flag="0", width=3),
                             sep="")

    return(chunkprefix)
}

RweaveEvalWithOpt <- function (expr, options){
    if(options$eval){
        res <- try(.Internal(eval.with.vis(expr, .GlobalEnv, baseenv())),
                   silent=TRUE)
        if(inherits(res, "try-error")) return(res)
        if(options$print | (options$term & res$visible))
            print(res$value)
    }
    return(res)
}


RweaveTryStop <- function(err, options){

    if(inherits(err, "try-error")){
        cat("\n")
        msg <- paste(" chunk", options$chunknr)
        if(!is.null(options$label))
            msg <- paste(msg, " (label=", options$label, ")", sep="")
        msg <- paste(msg, "\n")
        stop(msg, err, call.=FALSE)
    }
}





###**********************************************************

Stangle <- function(file, driver=Rtangle(),
                    syntax=getOption("SweaveSyntax"), ...)
{
    Sweave(file=file, driver=driver, ...)
}

RtangleReST <-  function()
{
    list(setup = RtangleReSTSetup,
         runcode = RtangleReSTRuncode,
         writedoc = RtangleReSTWritedoc,
         finish = RtangleReSTFinish,
         checkopts = RweaveReSTOptions)
}


RtangleReSTSetup <- function(file, syntax,
                         output=NULL, annotate=TRUE, split=FALSE,
                         prefix=TRUE, quiet=FALSE)
{
    if(is.null(output)){
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "R", sep=".")
    }
    else{
        prefix.string <- basename(sub("\\.[rsRS]$", "", output))
    }

    if(!split){
        if(!quiet)
            cat("Writing to file", output, "\n")
        output <- file(output, open="w")
    }
    else{
        if(!quiet)
            cat("Writing chunks to files ...\n")
        output <- NULL
    }

    options <- list(split=split, prefix=prefix,
                    prefix.string=prefix.string,
                    engine="R", eval=TRUE)

    list(output=output, annotate=annotate, options=options,
         chunkout=list(), quiet=quiet, syntax=syntax)
}


RtangleReSTRuncode <-  function(object, chunk, options)
{
    if(!(options$engine %in% c("R", "S"))){
        return(object)
    }

    chunkprefix <- RweaveChunkPrefix(options)

    if(options$split){
        outfile <- paste(chunkprefix, options$engine, sep=".")
        if(!object$quiet)
            cat(options$chunknr, ":", outfile,"\n")
        ## [x][[1L]] avoids partial matching of x
        chunkout <- object$chunkout[chunkprefix][[1L]]
        if(is.null(chunkout)){
            chunkout <- file(outfile, "w")
            if(!is.null(options$label))
                object$chunkout[[chunkprefix]] <- chunkout
        }
    }
    else
        chunkout <- object$output

    if(object$annotate){
        cat("###################################################\n",
            "### chunk number ", options$chunknr,
            ": ", options$label,
            ifelse(options$eval, "", " eval=FALSE"), "\n",
            "###################################################\n",
            file=chunkout, append=TRUE, sep="")
    }

    hooks <- SweaveHooks(options, run=FALSE)
    for(k in hooks)
        cat("getOption(\"SweaveHooks\")[[\"", k, "\"]]()\n",
            file=chunkout, append=TRUE, sep="")

    if(!options$eval)
        chunk <- paste("##", chunk)

    cat(chunk,"\n", file=chunkout, append=TRUE, sep="\n")

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

    return(object)
}

RtangleReSTWritedoc <- function(object, chunk)
{
    while(length(pos <- grep(object$syntax$docopt, chunk)))
    {
        opts <- sub(paste(".*", object$syntax$docopt, ".*", sep=""),
                    "\\1", chunk[pos[1L]])
        object$options <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveReSTOptions)
        chunk[pos[1L]] <- sub(object$syntax$docopt, "", chunk[pos[1L]])
    }
    return(object)
}


RtangleReSTFinish <- function(object, error=FALSE)
{
    if(!is.null(object$output))
        close(object$output)

    if(length(object$chunkout)) {
        for(con in object$chunkout) close(con)
    }
}


#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/RweaveT2t.r"
RweaveT2t <- function()
{
    list(setup = RweaveT2tSetup,
         runcode = RweaveT2tRuncode,
         writedoc = RweaveT2tWritedoc,
         finish = RweaveT2tFinish,
         checkopts = RweaveT2tOptions)
}

RweaveT2tSetup <-
    function(file, syntax, output=NULL, quiet=FALSE, debug=FALSE,
             stylepath, ...)
{
    dots <- list(...)
    if(is.null(output)) {
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "t2t", sep=".")
    } else prefix.string <- basename(sub("\\.t2t$", "", output))

    if(!quiet) cat("Writing to file ", output, "\n",
                   "Processing code chunks ...\n", sep="")
    output <- file(output, open="w+")

    options <- list(prefix=TRUE, prefix.string=prefix.string,
                    engine="R", print=FALSE, eval=TRUE,
                    fig=FALSE, ext = "jpg", png=FALSE, jpg=TRUE, pdf=TRUE, eps=FALSE,
                    width=6, height=6, res=100, term=TRUE,
                    echo=TRUE, keep.source=FALSE, results="verbatim",
                    split=FALSE, strip.white="true", include=TRUE,
                    pdf.version=grDevices::pdf.options()$version,
                    pdf.encoding=grDevices::pdf.options()$encoding,
                    concordance=FALSE, expand=TRUE)
    options[names(dots)] <- dots

    ## to be on the safe side: see if defaults pass the check
    options <- RweaveT2tOptions(options)

    list(output=output, 
         debug=debug, quiet=quiet, syntax = syntax,
         options=options, chunkout=list(), srclines=integer(0L),
         srcfile=srcfile(file))
}

makeRweaveT2tCodeRunner <- 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.
    RweaveT2tRuncode <- 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$png) cat(" png")
                      if(options$jpg) cat(" jpg")
                      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, "t2t", sep="."), "w")
                  if(!is.null(options$label))
                    object$chunkout[[chunkprefix]] <- chunkout
              }
          }
          else
            chunkout <- object$output

      saveopts <- options(keep.source=options$keep.source)
      on.exit(options(saveopts))

          SweaveHooks(options, run=TRUE)

          chunkexps <- try(parse(text=chunk), silent=TRUE)
          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")
      if (options$expand)
        lastshown <- 0L
      else
        lastshown <- srcline - 1L
      thisline <- 0
          for(nce in 1L:length(chunkexps))
            {
                ce <- chunkexps[[nce]]
                if (nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) {
                    if (options$expand) {
                    srcfile <- attr(srcref, "srcfile")
                    showfrom <- srcref[1L]
                    showto <- srcref[3L]
                    } else {
                        srcfile <- object$srcfile
                        showfrom <- srclines[srcref[1L]]
                        showto <- srclines[srcref[3L]]
                    }
                    dce <- getSrcLines(srcfile, lastshown+1, showto)
                leading <- showfrom-lastshown
                lastshown <- showto
                    srcline <- srclines[srcref[3L]]
                    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("```\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1] <- srcline
                            thisline <- thisline + 1
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        openSinput <- TRUE
                    }
            cat("", 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 + 1L:length(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("") # 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) == 0 | options$results == "hide") cat("\n", file=chunkout, append=TRUE)

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

                    if(openSinput){
                        cat("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2L] <- srcline
                        thisline <- thisline + 2L
                        openSinput <- FALSE
                    }
                    if(options$results=="verbatim"){
                        if(!openSchunk){
                            cat("```\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        linesout[thisline + 1L] <- srcline
                        thisline <- thisline + 1L
                    }
                    if(options$results=="ascii"){
                        if(openSinput){
                            cat("",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        if(openSchunk){
                            cat("```\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- FALSE
                        }
                        addabreak <- "\n"
                    }
                    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,addabreak, addabreak, 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("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2] <- srcline
                        thisline <- thisline + 2L
                    }
                }
            }

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

          if(openSchunk){
              cat("```\n", 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("%!include: ", chunkprefix, ".t2t\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$png){
                  png(file=paste(chunkprefix, "png", sep="."),width=options$width,height=options$height,units="in",res=options$res)

                  err <- try({SweaveHooks(options, run=TRUE);
                        eval(chunkexps, envir=.GlobalEnv)})
                  dev.off()
                  if(inherits(err, "try-error")) stop(err)
              }
              if(options$jpg){
                  jpeg(file=paste(chunkprefix, "jpg", sep="."),width=options$width,height=options$height,quality=100,units="in",res=options$res)

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

RweaveT2tRuncode <- makeRweaveT2tCodeRunner()

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

    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="") # Mais qu'est-ce ??

        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 <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveT2tOptions)
            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)
}

RweaveT2tFinish <- function(object, error=FALSE)
{
    outputname <- summary(object$output)$description
    inputname <- object$srcfile$filename
    if(!object$quiet && !error)
        cat("\n",
            gettextf("You can now run txt2tags on '%s'", outputname),
            "\n", sep = "")
    close(object$output)
    if(length(object$chunkout))
        for(con in object$chunkout) close(con)
#    if (object$haveconcordance) {
        # This output format is subject to change.  Currently it contains
        # three parts, separated by colons:
        # 1.  The output .tex filename
        # 2.  The input .Rnw filename
        # 3.  The input line numbers corresponding to each output line.
        #     This are compressed using the following simple scheme:
        #     The first line number, followed by
        #     a run-length encoded diff of the rest of the line numbers.
#        linesout <- object$linesout
#        vals <- rle(diff(linesout))
#        vals <- c(linesout[1L], as.numeric(rbind(vals$lengths, vals$values)))
#        concordance <- paste(strwrap(paste(vals, collapse=" ")), collapse=" %\n")
#        special <- paste("\\Sconcordance{concordance:", outputname, ":", inputname, ":%\n",
#                 concordance,"}\n", sep="")
#        cat(special, file=object$concordfile)
#    }
    invisible(outputname)
}

RweaveT2tOptions <- function(options)
{

    ## ATTENTION: Changes in this function have to be reflected in the
    ## defaults in the init function!

    ## convert a character string to logical
    c2l <- function(x){
        if(is.null(x)) return(FALSE)
        else return(as.logical(toupper(as.character(x))))
    }

    NUMOPTS <- c("width", "height", "res")
    NOLOGOPTS <- c(NUMOPTS, "ext", "results", "prefix.string",
                   "engine", "label", "strip.white",
                   "pdf.version", "pdf.encoding", "pointsize")

    for(opt in names(options)){
        if(! (opt %in% NOLOGOPTS)){
            oldval <- options[[opt]]
            if(!is.logical(options[[opt]])){
                options[[opt]] <- c2l(options[[opt]])
            }
            if(is.na(options[[opt]]))
                stop(gettextf("invalid value for '%s' : %s", opt, oldval),
                     domain = NA)
        }
        else if(opt %in% NUMOPTS){
            options[[opt]] <- as.numeric(options[[opt]])
        }
    }

    if(!is.null(options$results))
        options$results <- tolower(as.character(options$results))
    options$results <- match.arg(options$results,
                                 c("verbatim", "ascii", "hide"))

    if(!is.null(options$strip.white))
        options$strip.white <- tolower(as.character(options$strip.white))
    options$strip.white <- match.arg(options$strip.white,
                                     c("true", "false", "all"))

    options
}


RweaveChunkPrefix <- function(options)
{
    if(!is.null(options$label)){
        if(options$prefix)
            chunkprefix <- paste(options$prefix.string, "-",
                                 options$label, sep="")
        else
            chunkprefix <- options$label
    }
    else
        chunkprefix <- paste(options$prefix.string, "-",
                             formatC(options$chunknr, flag="0", width=3),
                             sep="")

    return(chunkprefix)
}

RweaveEvalWithOpt <- function (expr, options){
    if(options$eval){
        res <- try(.Internal(eval.with.vis(expr, .GlobalEnv, baseenv())),
                   silent=TRUE)
        if(inherits(res, "try-error")) return(res)
        if(options$print | (options$term & res$visible))
            print(res$value)
    }
    return(res)
}


RweaveTryStop <- function(err, options){

    if(inherits(err, "try-error")){
        cat("\n")
        msg <- paste(" chunk", options$chunknr)
        if(!is.null(options$label))
            msg <- paste(msg, " (label=", options$label, ")", sep="")
        msg <- paste(msg, "\n")
        stop(msg, err, call.=FALSE)
    }
}





###**********************************************************

Stangle <- function(file, driver=Rtangle(),
                    syntax=getOption("SweaveSyntax"), ...)
{
    Sweave(file=file, driver=driver, ...)
}

RtangleT2t <-  function()
{
    list(setup = RtangleT2tSetup,
         runcode = RtangleT2tRuncode,
         writedoc = RtangleT2tWritedoc,
         finish = RtangleT2tFinish,
         checkopts = RweaveT2tOptions)
}


RtangleT2tSetup <- function(file, syntax,
                         output=NULL, annotate=TRUE, split=FALSE,
                         prefix=TRUE, quiet=FALSE)
{
    if(is.null(output)){
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "R", sep=".")
    }
    else{
        prefix.string <- basename(sub("\\.[rsRS]$", "", output))
    }

    if(!split){
        if(!quiet)
            cat("Writing to file", output, "\n")
        output <- file(output, open="w")
    }
    else{
        if(!quiet)
            cat("Writing chunks to files ...\n")
        output <- NULL
    }

    options <- list(split=split, prefix=prefix,
                    prefix.string=prefix.string,
                    engine="R", eval=TRUE)

    list(output=output, annotate=annotate, options=options,
         chunkout=list(), quiet=quiet, syntax=syntax)
}


RtangleT2tRuncode <-  function(object, chunk, options)
{
    if(!(options$engine %in% c("R", "S"))){
        return(object)
    }

    chunkprefix <- RweaveChunkPrefix(options)

    if(options$split){
        outfile <- paste(chunkprefix, options$engine, sep=".")
        if(!object$quiet)
            cat(options$chunknr, ":", outfile,"\n")
        ## [x][[1L]] avoids partial matching of x
        chunkout <- object$chunkout[chunkprefix][[1L]]
        if(is.null(chunkout)){
            chunkout <- file(outfile, "w")
            if(!is.null(options$label))
                object$chunkout[[chunkprefix]] <- chunkout
        }
    }
    else
        chunkout <- object$output

    if(object$annotate){
        cat("###################################################\n",
            "### chunk number ", options$chunknr,
            ": ", options$label,
            ifelse(options$eval, "", " eval=FALSE"), "\n",
            "###################################################\n",
            file=chunkout, append=TRUE, sep="")
    }

    hooks <- SweaveHooks(options, run=FALSE)
    for(k in hooks)
        cat("getOption(\"SweaveHooks\")[[\"", k, "\"]]()\n",
            file=chunkout, append=TRUE, sep="")

    if(!options$eval)
        chunk <- paste("##", chunk)

    cat(chunk,"\n", file=chunkout, append=TRUE, sep="\n")

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

    return(object)
}

RtangleT2tWritedoc <- function(object, chunk)
{
    while(length(pos <- grep(object$syntax$docopt, chunk)))
    {
        opts <- sub(paste(".*", object$syntax$docopt, ".*", sep=""),
                    "\\1", chunk[pos[1L]])
        object$options <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveT2tOptions)
        chunk[pos[1L]] <- sub(object$syntax$docopt, "", chunk[pos[1L]])
    }
    return(object)
}


RtangleT2tFinish <- function(object, error=FALSE)
{
    if(!is.null(object$output))
        close(object$output)

    if(length(object$chunkout)) {
        for(con in object$chunkout) close(con)
    }
}


#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/RweaveTextile.r"
RweaveTextile <- function()
{
    list(setup = RweaveTextileSetup,
         runcode = RweaveTextileRuncode,
         writedoc = RweaveTextileWritedoc,
         finish = RweaveTextileFinish,
         checkopts = RweaveTextileOptions)
}

RweaveTextileSetup <-
    function(file, syntax, output=NULL, quiet=FALSE, debug=FALSE,
             stylepath, ...)
{
    dots <- list(...)
    if(is.null(output)) {
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "txt", sep=".")
    } else prefix.string <- basename(sub("\\.txt$", "", output))

    if(!quiet) cat("Writing to file ", output, "\n",
                   "Processing code chunks ...\n", sep="")
    output <- file(output, open="w+")

    options <- list(prefix=TRUE, prefix.string=prefix.string,
                    engine="R", print=FALSE, eval=TRUE,
                    fig=FALSE, ext = "jpg", png=FALSE, jpg=TRUE, pdf=TRUE, eps=FALSE,
                    width=6, height=6, res=100, term=TRUE,
                    echo=TRUE, keep.source=FALSE, results="verbatim",
                    split=FALSE, strip.white="true", include=TRUE,
                    pdf.version=grDevices::pdf.options()$version,
                    pdf.encoding=grDevices::pdf.options()$encoding,
                    concordance=FALSE, expand=TRUE)
    options[names(dots)] <- dots

    ## to be on the safe side: see if defaults pass the check
    options <- RweaveTextileOptions(options)

    list(output=output, 
         debug=debug, quiet=quiet, syntax = syntax,
         options=options, chunkout=list(), srclines=integer(0L),
         srcfile=srcfile(file))
}

makeRweaveTextileCodeRunner <- 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.
    RweaveTextileRuncode <- 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$png) cat(" png")
                      if(options$jpg) cat(" jpg")
                      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, "txt", sep="."), "w")
                  if(!is.null(options$label))
                    object$chunkout[[chunkprefix]] <- chunkout
              }
          }
          else
            chunkout <- object$output

      saveopts <- options(keep.source=options$keep.source)
      on.exit(options(saveopts))

          SweaveHooks(options, run=TRUE)

          chunkexps <- try(parse(text=chunk), silent=TRUE)
          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")
      if (options$expand)
        lastshown <- 0L
      else
        lastshown <- srcline - 1L
      thisline <- 0
          for(nce in 1L:length(chunkexps))
            {
                ce <- chunkexps[[nce]]
                if (nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) {
                    if (options$expand) {
                    srcfile <- attr(srcref, "srcfile")
                    showfrom <- srcref[1L]
                    showto <- srcref[3L]
                    } else {
                        srcfile <- object$srcfile
                        showfrom <- srclines[srcref[1L]]
                        showto <- srclines[srcref[3L]]
                    }
                    dce <- getSrcLines(srcfile, lastshown+1, showto)
                leading <- showfrom-lastshown
                lastshown <- showto
                    srcline <- srclines[srcref[3L]]
                    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("<pre>\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1] <- srcline
                            thisline <- thisline + 1
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        openSinput <- TRUE
                    }
            cat("", 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 + 1L:length(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("") # 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) == 0 | options$results == "hide") cat("\n", file=chunkout, append=TRUE)

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

                    if(openSinput){
                        cat("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2L] <- srcline
                        thisline <- thisline + 2L
                        openSinput <- FALSE
                    }
                    if(options$results=="verbatim"){
                        if(!openSchunk){
                            cat("<pre>\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        cat("",
                            file=chunkout, append=TRUE)
                        linesout[thisline + 1L] <- srcline
                        thisline <- thisline + 1L
                    }
                    if(options$results=="ascii"){
                        if(openSinput){
                            cat("",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- TRUE
                        }
                        if(openSchunk){
                            cat("</pre>\n",
                                file=chunkout, append=TRUE)
                            linesout[thisline + 1L] <- srcline
                            thisline <- thisline + 1L
                            openSchunk <- FALSE
                        }
                        addabreak <- "\n"
                    }
                    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,addabreak, 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("\n", file=chunkout, append=TRUE)
                        linesout[thisline + 1L:2] <- srcline
                        thisline <- thisline + 2L
                    }
                }
            }

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

          if(openSchunk){
              cat("</pre>\n", 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("<object type=\"text/plain\" data=\"", chunkprefix, ".html\" border=\"0\" style=\"overflow: hidden;\"></object>\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$png){
                  png(file=paste(chunkprefix, "png", sep="."),width=options$width,height=options$height,units="in",res=options$res)

                  err <- try({SweaveHooks(options, run=TRUE);
                        eval(chunkexps, envir=.GlobalEnv)})
                  dev.off()
                  if(inherits(err, "try-error")) stop(err)
              }
              if(options$jpg){
                  jpeg(file=paste(chunkprefix, "jpg", sep="."),width=options$width,height=options$height,quality=100,units="in",res=options$res)

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

RweaveTextileRuncode <- makeRweaveTextileCodeRunner()

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

    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="") # Mais qu'est-ce ??

        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 <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveTextileOptions)
            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)
}

RweaveTextileFinish <- function(object, error=FALSE)
{
    outputname <- summary(object$output)$description
    inputname <- object$srcfile$filename
    if(!object$quiet && !error)
        cat("\n",
            gettextf("You can now run textile on '%s'", outputname),
            "\n", sep = "")
    close(object$output)
    if(length(object$chunkout))
        for(con in object$chunkout) close(con)
#    if (object$haveconcordance) {
        # This output format is subject to change.  Currently it contains
        # three parts, separated by colons:
        # 1.  The output .tex filename
        # 2.  The input .Rnw filename
        # 3.  The input line numbers corresponding to each output line.
        #     This are compressed using the following simple scheme:
        #     The first line number, followed by
        #     a run-length encoded diff of the rest of the line numbers.
#        linesout <- object$linesout
#        vals <- rle(diff(linesout))
#        vals <- c(linesout[1L], as.numeric(rbind(vals$lengths, vals$values)))
#        concordance <- paste(strwrap(paste(vals, collapse=" ")), collapse=" %\n")
#        special <- paste("\\Sconcordance{concordance:", outputname, ":", inputname, ":%\n",
#                 concordance,"}\n", sep="")
#        cat(special, file=object$concordfile)
#    }
    invisible(outputname)
}

RweaveTextileOptions <- function(options)
{

    ## ATTENTION: Changes in this function have to be reflected in the
    ## defaults in the init function!

    ## convert a character string to logical
    c2l <- function(x){
        if(is.null(x)) return(FALSE)
        else return(as.logical(toupper(as.character(x))))
    }

    NUMOPTS <- c("width", "height", "res")
    NOLOGOPTS <- c(NUMOPTS, "ext", "results", "prefix.string",
                   "engine", "label", "strip.white",
                   "pdf.version", "pdf.encoding", "pointsize")

    for(opt in names(options)){
        if(! (opt %in% NOLOGOPTS)){
            oldval <- options[[opt]]
            if(!is.logical(options[[opt]])){
                options[[opt]] <- c2l(options[[opt]])
            }
            if(is.na(options[[opt]]))
                stop(gettextf("invalid value for '%s' : %s", opt, oldval),
                     domain = NA)
        }
        else if(opt %in% NUMOPTS){
            options[[opt]] <- as.numeric(options[[opt]])
        }
    }

    if(!is.null(options$results))
        options$results <- tolower(as.character(options$results))
    options$results <- match.arg(options$results,
                                 c("verbatim", "ascii", "hide"))

    if(!is.null(options$strip.white))
        options$strip.white <- tolower(as.character(options$strip.white))
    options$strip.white <- match.arg(options$strip.white,
                                     c("true", "false", "all"))

    options
}


RweaveChunkPrefix <- function(options)
{
    if(!is.null(options$label)){
        if(options$prefix)
            chunkprefix <- paste(options$prefix.string, "-",
                                 options$label, sep="")
        else
            chunkprefix <- options$label
    }
    else
        chunkprefix <- paste(options$prefix.string, "-",
                             formatC(options$chunknr, flag="0", width=3),
                             sep="")

    return(chunkprefix)
}

RweaveEvalWithOpt <- function (expr, options){
    if(options$eval){
        res <- try(.Internal(eval.with.vis(expr, .GlobalEnv, baseenv())),
                   silent=TRUE)
        if(inherits(res, "try-error")) return(res)
        if(options$print | (options$term & res$visible))
            print(res$value)
    }
    return(res)
}


RweaveTryStop <- function(err, options){

    if(inherits(err, "try-error")){
        cat("\n")
        msg <- paste(" chunk", options$chunknr)
        if(!is.null(options$label))
            msg <- paste(msg, " (label=", options$label, ")", sep="")
        msg <- paste(msg, "\n")
        stop(msg, err, call.=FALSE)
    }
}





###**********************************************************

Stangle <- function(file, driver=Rtangle(),
                    syntax=getOption("SweaveSyntax"), ...)
{
    Sweave(file=file, driver=driver, ...)
}

RtangleTextile <-  function()
{
    list(setup = RtangleTextileSetup,
         runcode = RtangleTextileRuncode,
         writedoc = RtangleTextileWritedoc,
         finish = RtangleTextileFinish,
         checkopts = RweaveTextileOptions)
}


RtangleTextileSetup <- function(file, syntax,
                         output=NULL, annotate=TRUE, split=FALSE,
                         prefix=TRUE, quiet=FALSE)
{
    if(is.null(output)){
        prefix.string <- basename(sub(syntax$extension, "", file))
        output <- paste(prefix.string, "R", sep=".")
    }
    else{
        prefix.string <- basename(sub("\\.[rsRS]$", "", output))
    }

    if(!split){
        if(!quiet)
            cat("Writing to file", output, "\n")
        output <- file(output, open="w")
    }
    else{
        if(!quiet)
            cat("Writing chunks to files ...\n")
        output <- NULL
    }

    options <- list(split=split, prefix=prefix,
                    prefix.string=prefix.string,
                    engine="R", eval=TRUE)

    list(output=output, annotate=annotate, options=options,
         chunkout=list(), quiet=quiet, syntax=syntax)
}


RtangleTextileRuncode <-  function(object, chunk, options)
{
    if(!(options$engine %in% c("R", "S"))){
        return(object)
    }

    chunkprefix <- RweaveChunkPrefix(options)

    if(options$split){
        outfile <- paste(chunkprefix, options$engine, sep=".")
        if(!object$quiet)
            cat(options$chunknr, ":", outfile,"\n")
        ## [x][[1L]] avoids partial matching of x
        chunkout <- object$chunkout[chunkprefix][[1L]]
        if(is.null(chunkout)){
            chunkout <- file(outfile, "w")
            if(!is.null(options$label))
                object$chunkout[[chunkprefix]] <- chunkout
        }
    }
    else
        chunkout <- object$output

    if(object$annotate){
        cat("###################################################\n",
            "### chunk number ", options$chunknr,
            ": ", options$label,
            ifelse(options$eval, "", " eval=FALSE"), "\n",
            "###################################################\n",
            file=chunkout, append=TRUE, sep="")
    }

    hooks <- SweaveHooks(options, run=FALSE)
    for(k in hooks)
        cat("getOption(\"SweaveHooks\")[[\"", k, "\"]]()\n",
            file=chunkout, append=TRUE, sep="")

    if(!options$eval)
        chunk <- paste("##", chunk)

    cat(chunk,"\n", file=chunkout, append=TRUE, sep="\n")

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

    return(object)
}

RtangleTextileWritedoc <- function(object, chunk)
{
    while(length(pos <- grep(object$syntax$docopt, chunk)))
    {
        opts <- sub(paste(".*", object$syntax$docopt, ".*", sep=""),
                    "\\1", chunk[pos[1L]])
        object$options <- utils:::SweaveParseOptions(opts, object$options,
                                             RweaveTextileOptions)
        chunk[pos[1L]] <- sub(object$syntax$docopt, "", chunk[pos[1L]])
    }
    return(object)
}


RtangleTextileFinish <- function(object, error=FALSE)
{
    if(!is.null(object$output))
        close(object$output)

    if(length(object$chunkout)) {
        for(con in object$chunkout) close(con)
    }
}


#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/SweaveAscii.r"
Asciidoc <- Sweave
formals(Asciidoc) <-  alist(file=, driver=RweaveAsciidoc, syntax=SweaveSyntaxNoweb, ...=)

T2t <- Sweave
formals(T2t) <-  alist(file=, driver=RweaveT2t, syntax=SweaveSyntaxNoweb, ...=)

ReST <- Sweave
formals(ReST) <-  alist(file=, driver=RweaveReST, syntax=SweaveSyntaxNoweb, ...=)

Org <- Sweave
formals(Org) <-  alist(file=, driver=RweaveOrg, syntax=SweaveSyntaxNoweb, ...=)

Textile <- Sweave
formals(Textile) <-  alist(file=, driver=RweaveTextile, syntax=SweaveSyntaxNoweb, ...=)
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiAnova.r"
ascii.anova <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(x, check.names = FALSE)
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
         include.colnames = include.colnames,
         rownames = rownames, colnames = colnames, format = format,
         digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.aov <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
  ascii.anova(unclass(summary(x))[[1]], include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format,digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign, tvalign = tvalign,
         tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign, bvalign = bvalign,
         bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign, lvalign = lvalign,
         lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
}

ascii.summary.aov <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
  ascii.anova(unclass(x)[[1]], include.rownames = include.rownames,
         rownames = rownames, colnames = colnames, 
         include.colnames = include.colnames, format = format,
         digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid,valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign, tvalign = tvalign,
         tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign, bvalign = bvalign,
         bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign, lvalign = lvalign,
         lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
}

ascii.aovlist <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
  y <- summary(x)
  n <- length(y)
  if (n == 1) ascii.anova(unclass(y[[1]][[1]]), include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid,valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign, tvalign = tvalign,
         tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign, bvalign = bvalign,
         bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign, lvalign = lvalign,
         lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
  else {
    z <- y[[1]][[1]]
    for (i in 2:n) z <- rbind(z, y[[i]][[1]])
    ascii.anova(z, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = NULL, colnames = NULL, format = format,
         digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, width = width, frame = frame, grid = grid,
         valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign, tvalign = tvalign,
         tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign, bvalign = bvalign,
         bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign, lvalign = lvalign,
         lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
  }
}

ascii.summary.aovlist <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
  n <- length(x)
  if (n == 1) ascii.anova(unclass(x[[1]][[1]]), include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign, tvalign = tvalign,
         tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign, bvalign = bvalign,
         bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign, lvalign = lvalign,
         lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
  else {
    z <- x[[1]][[1]]
    for (i in 2:n) z <- rbind(z, x[[i]][[1]])
    ascii.anova(z, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign, tvalign = tvalign,
         tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign, bvalign = bvalign,
         bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign, lvalign = lvalign,
         lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
  }
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiDataFrame.r"
ascii.data.frame <- function(x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...) {
  obj <- asciiDataFrame$new(x, include.rownames, include.colnames, rownames, colnames, format, digits, decimal.mark, na.print, caption, caption.level, width, frame, grid, valign, header, footer, align, col.width, style, tgroup, n.tgroup, talign, tvalign, tstyle, bgroup, n.bgroup, balign, bvalign, bstyle, lgroup, n.lgroup, lalign, lvalign, lstyle, rgroup, n.rgroup, ralign, rvalign, rstyle)
	class(obj) <- c("ascii", "proto", "environment")
	return(obj)
}

#~ # from package reshape (Hadley Wickham : http://had.co.nz/reshape/)
ascii.cast_df <-function (x, include.rownames = FALSE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(x)
  obj <- asciiDataFrame$new(x, include.rownames, include.colnames, rownames, colnames, format, digits, decimal.mark, na.print, caption, caption.level, width, frame, grid, valign, header, footer, align, col.width, style, tgroup, n.tgroup, talign, tvalign, tstyle, bgroup, n.bgroup, balign, bvalign, bstyle, lgroup, n.lgroup, lalign, lvalign, lstyle, rgroup, n.rgroup, ralign, rvalign, rstyle)
	class(obj) <- c("ascii", "proto", "environment")
	return(obj)
  }
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiDefault.r"
ascii.default <- function(x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...) {
  y <- as.data.frame(x)
  obj <- asciiDataFrame$new(y, include.rownames, include.colnames, rownames, colnames, format, digits, decimal.mark, na.print, caption, caption.level, width, frame, grid, valign, header, footer, align, col.width, style, tgroup = tgroup, n.tgroup = n.tgroup, talign = talign, tvalign = tvalign, tstyle = tstyle, bgroup = bgroup, n.bgroup = n.bgroup, balign = balign, bvalign = bvalign, bstyle = bstyle, lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign, lvalign = lvalign, lstyle = lstyle, rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign, rvalign = rvalign, rstyle = rstyle)
	class(obj) <- c("ascii", "proto", "environment")
	return(obj)
}

#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiDensity.r"
ascii.density <- function (x, include.rownames = FALSE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    y <- unclass(x)
    res <- summary(data.frame(x = y$x, y = y$y))
    obj <- ascii(x = res, include.rownames = include.rownames, 
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiDescr.r"
ascii.meanscomp <- function (x, header = TRUE, caption = "", include.rownames = TRUE, include.colnames = TRUE, ...) {                 
    rlab <- ifelse(is.null(x$row.label), x$row, x$row.label)
    clab <- ifelse(is.null(x$column.label), x$column, x$column.label)
    msg1 <- gettext("Mean value of", domain = "R-descr")             
    msg2 <- gettext("according to", domain = "R-descr")              
    msg <- switch(1 + (caption == ""), caption, paste(msg1, " \"", clab, "\" ", msg2, " \"", rlab, "\"", sep = ""))
    ascii(x$table, caption = msg, include.rownames = include.rownames, include.colnames = include.colnames, header = header, ...)
}

ascii.CrossTable <- function (x, ...) {                 
    t <- x$t      
    CPR <- x$prop.row
    CPC <- x$prop.col
    CPT <- x$prop.tbl
    GT <- x$gt       
    RS <- x$rs       
    CS <- x$cs       
    TotalN <- x$total.n
    CST <- x$chisq     
    CSTc <- x$chisq.corr
    FTt <- x$fisher.ts  
    FTl <- x$fisher.lt  
    FTg <- x$fisher.gt  
    McN <- x$mcnemar    
    McNc <- x$mcnemar.corr
    ASR <- x$asr          
    RowData <- x$RowData  
    ColData <- x$ColData  
    digits <- x$digits    
    max.width <- x$max.width
    vector.x <- x$vector.x  
    expected <- x$expected  
    prop.r <- (is.na(CPR[1]) == FALSE)
    prop.c <- (is.na(CPC[1]) == FALSE)
    prop.t <- (is.na(CPT[1]) == FALSE)
    chisq <- (is.na(CST[1]) == FALSE) 
    prop.chisq <- x$prop.chisq        
    fisher <- (class(FTt) == "htest") 
    resid <- x$resid                  
    sresid <- x$sresid                
    asresid <- x$asresid              
    mcnemar <- x$print.mcnemar        
    missing.include <- x$missing.include
    format <- x$format                  
    outDec <- getOption("OutDec")       
    nsep <- "  | "                      
    if (format == "SAS") {              
        resid <- sresid <- asresid <- FALSE
        hdd <- 1                           
        psep <- "  | "                     
    } else {                                 
        if (format == "SPSS") {            
            hdd <- 100                     
            psep <- "% | "                 
        } else {                             
            stop("unknown format")         
        }                                  
    }                                      
    if (vector.x)                          
        expected <- prop.chisq <- prop.c <- prop.t <- resid <- sresid <- asresid <- FALSE
    ColTotal <- gettext("Total", domain = "R-descr")                                     
    RowTotal <- ColTotal                                                                 
    CWidth <- max(digits + 2, c(nchar(t), nchar(dimnames(t)[[2]]),                       
        nchar(RS), nchar(CS), nchar(RowTotal)))                                          
    RWidth <- max(c(nchar(dimnames(t)[[1]]), nchar(ColTotal)))                           
    if (is.na(RowData) == FALSE)                                                         
        RWidth <- max(RWidth, nchar(RowData))                                            
    RowSep <- paste(rep("-", CWidth + 2), collapse = "")                                 
    RowSep1 <- paste(rep("-", RWidth + 1), collapse = "")                                
    SpaceSep1 <- paste(rep(" ", RWidth), collapse = "")                                  
    SpaceSep2 <- paste(rep(" ", CWidth), collapse = "")                                  
    FirstCol <- formatC(dimnames(t)[[1]], width = RWidth, format = "s")                  
    ColTotal <- formatC(ColTotal, width = RWidth, format = "s")                          
    RowTotal <- formatC(RowTotal, width = CWidth, format = "s")                          
    caption <- gettext("Cell Contents", domain = "R-descr")
    if (format == "SAS") {                                                               
        content <- c("N", 
                        ifelse(expected, "Expected N", NA), 
                        ifelse(prop.chisq, "Chi-square contribution", NA), 
                        ifelse(prop.r, "N / Row Total", NA), 
                        ifelse(prop.c, "N / Col Total", NA), 
                        ifelse(prop.t, "N / Table Total", NA)
                        )
        content <- as.list(content[!is.na(content)])
      } else if (format == "SPSS") {                                                         
        content <- c("Count", 
                        ifelse(expected, "Expected Values", NA), 
                        ifelse(prop.chisq, "Chi-square contribution", NA), 
                        ifelse(prop.r, "Row Percent", NA), 
                        ifelse(prop.c, "Column Percent", NA), 
                        ifelse(prop.t, "Total Percent", NA), 
                        ifelse(resid, "Residual", NA), 
                        ifelse(sresid, "Std Residual", NA), 
                        ifelse(asresid, "Adj Std Resid", NA)
                        )
        content <- as.list(content[!is.na(content)])
    }                                                                                    
    if (vector.x) {                                                                      
      stop("For single vector description, use freq() function in package descr.\n")
    }                                                                                               
    nelements <- 1 + expected + prop.chisq + prop.r + prop.c +                                      
        prop.t + resid + sresid + asresid                                                        
    nr <- nrow(t) * nelements + 1 + prop.c                                                           
    nc <- ncol(t)                                                                                   
    m <- matrix(nrow = nr, ncol = nc + 1)                                                           
    rnames <- rownames(t)                                              
    n.rnames <- vector(mode = "numeric", length = nrow(t) + 1)
    k <- 1                                                                                          
    for (i in 1:nrow(t)) {                                                                          
        for (l in 1:nc) m[k, l] <- formatC(t[i, l], format = "d")                                   
        m[k, nc + 1] <- RS[i]                                                                       
        n.rnames[i] <- 1
        k <- k + 1                                                                                  
        if (expected) {                                                                             
            for (l in 1:nc) m[k, l] <- formatC(CST$expected[i,                                      
                l], digits = 1, format = "f", decimal.mark = outDec)                                
            m[k, nc + 1] <- " "                                                                     
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
        if (prop.chisq) {                                                                           
            for (l in 1:nc) m[k, l] <- formatC((((CST$expected[i,                                   
                l] - t[i, l])^2)/CST$expected[i, l]), digits = digits,                              
                format = "f", decimal.mark = outDec)                                                
            m[k, nc + 1] <- " "                                                                     
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
        if (prop.r) {                                                                               
            for (l in 1:nc) m[k, l] <- formatC(CPR[i, l] * hdd,                                     
                digits = digits, format = "f", decimal.mark = outDec)                               
            m[k, nc + 1] <- formatC(hdd * RS[i]/GT, digits = digits,                                
                format = "f", decimal.mark = outDec)                                                
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
        if (prop.c) {                                                                               
            for (l in 1:nc) m[k, l] <- formatC(CPC[i, l] * hdd,                                     
                digits = digits, format = "f", decimal.mark = outDec)                               
            m[k, nc + 1] <- " "                                                                     
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
        if (prop.t) {                                                                               
            for (l in 1:nc) m[k, l] <- formatC(CPT[i, l] * hdd,                                     
                digits = digits, format = "f", decimal.mark = outDec)                               
            m[k, nc + 1] <- " "                                                                     
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
        if (resid) {                                                                                
            for (l in 1:nc) m[k, l] <- formatC(CST$observed[i,                                      
                l] - CST$expected[i, l], digits = digits, format = "f",                             
                decimal.mark = outDec)                                                              
            m[k, nc + 1] <- " "                                                                     
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
        if (sresid) {                                                                               
            for (l in 1:nc) m[k, l] <- formatC(CST$residual[i,                                      
                l], digits = digits, format = "f", decimal.mark = outDec)                           
            m[k, nc + 1] <- " "                                                                     
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
        if (asresid) {                                                                              
            for (l in 1:nc) m[k, l] <- formatC(ASR[i, l], digits = digits,                          
                format = "f", decimal.mark = outDec)                                                
            m[k, nc + 1] <- " "                                                                     
            n.rnames[i] <- n.rnames[i] + 1
            k <- k + 1                                                                              
        }                                                                                           
      }
    ColTotal <- gettext("Total", domain = "R-descr")                                                
    RowTotal <- ColTotal                                                                            
    rnames[length(rnames) + 1] <- RowTotal                                                                           
    for (l in 1:nc) m[k, l] <- formatC(c(CS[l]), format = "d")                                      
    m[k, nc + 1] <- formatC(GT, format = "d")                                                       
    n.rnames[length(n.rnames)] <- 1
    if (prop.c) {
      k <- k + 1
      for (l in 1:nc) m[k, l] <- formatC(hdd * CS[l]/GT, digits = digits,
                              format = "f", decimal.mark = outDec)
      n.rnames[length(n.rnames)] <- 2
    }                                                                                           
    colnames(m) <- c(colnames(t), ColTotal)                                                         
    nc <- nc + 1                                                                                    
    mcolnames <- colnames(m)                                                                        
    rnames <- c("", rnames)
    n.rnames <- c(1, n.rnames)
    res.m <- ascii(m, include.colnames = T, header = T, lgroup = rnames, n.lgroup = n.rnames, lstyle = "s")
    res.t <- NULL
    if (chisq) {                                                                                    
      res.t <- list("Pearson's Chi-squared test" = paste(gettext("Chi^2 = ", domain = "R-descr"), format(CST$statistic),
                      ", ", gettext("d.f. = ", domain = "R-descr"), format(CST$parameter),                           
                      ", ", gettext("p = ", domain = "R-descr"), format(CST$p.value), sep = ""))
        if (all(dim(t) == 2)) {                                                                     
          res.t <- c(res.t, "Pearson's Chi-squared test with Yates' continuity correction" = paste(gettext("Chi^2 = ", domain = "R-descr"),
                       format(CSTc$statistic),                             
                       ", ", gettext("d.f. = ", domain = "R-descr"),                                      
                       format(CSTc$parameter), ", ", gettext("p = ", domain = "R-descr"),                         
                       format(CSTc$p.value), sep = ""))
        }
    }                                                                                               
    if (is.na(McN[1]) == FALSE) {                                                                   
        res.t <- c(res.t, "McNemar's Chi-squared test" = paste(gettext("Chi^2 = ", domain = "R-descr"), format(McN$statistic),                        
            ", ", gettext("d.f. = ", domain = "R-descr"), format(McN$parameter),
            ", ", gettext("p = ", domain = "R-descr"), format(McN$p.value), sep = ""))                                                            
        if (is.na(McNc[1]) == FALSE) {                                                              
            res.t <- c(res.t, "McNemar's Chi-squared test with continuity correction" = paste(gettext("Chi^2 = ", domain = "R-descr"), format(McNc$statistic),
                ", ", gettext("d.f. = ", domain = "R-descr"),                                      
                format(McNc$parameter), ", ", gettext("p = ", domain = "R-descr"),                         
                format(McNc$p.value), sep = ""))                                                                 
        }                                                                                           
    }                                                                                               
    if (fisher) {                                                                                   
      res.t <- c(res.t, "Fisher's Exact Test for Count Data" = paste(gettext("Alternative hypothesis: two.sided",
                          domain = "R-descr"), gettext(", p = ", domain = "R-descr"), format(FTt$p.value), sep = ""))
    }
    if (format == "SPSS") {
      if (any(dim(t) >= 2) & any(chisq, mcnemar, fisher)) {
            MinExpF = min(CST$expected)
            res.t <- c(res.t, list("Minimum expected frequency" = format(MinExpF)))
            NMinExpF = length(CST$expected[which(CST$expected <
                5)])
            if (NMinExpF > 0) {
                NCells = length(CST$expected)
                res.t <- c(res.t, "Cells with Expected Frequency < 5" = paste(format(NMinExpF), " ", "of ",
                  NCells, " (", format(100 * NMinExpF/NCells),
                  "%)", sep = ""))
            }
            ## cat("\n")
        }
    }
    content <- ascii(content, caption = "Cell Contents", caption.level = "s")
    if (!is.null(res.t))
      res.t <- ascii(res.t, caption = "Statistics for All Table Factors", caption.level = "s", list.type = "label")
    res <- asciiMixed$new(content, res.m, res.t)
    class(res) <- c("ascii", "proto", "environment")
    return(res)
  }

ascii.freqtable <- function (x, header = TRUE, footer = TRUE, digits = c(0, 2, 2), format = "f", na.print = "", include.rownames = TRUE, include.colnames = TRUE, caption = x$label, ...) {
  res <- x$freqtable
  ascii(res, header = header, footer = footer, include.rownames = include.rownames, include.colnames = include.colnames, caption = caption, digits = digits, format = format, na.print = na.print, ...)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiGlm.r"
ascii.glm <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
  x <- as.data.frame(summary(x)$coef)
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
          include.colnames = include.colnames, rownames = rownames, colnames = colnames,
          format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
          caption = caption, caption.level = caption.level, width = width, frame = frame,
          grid = grid, valign = valign, header = header, footer = footer, align = align,
          col.width = col.width, style = style,
          tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
          tvalign = tvalign, tstyle = tstyle,
          bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
          bvalign = bvalign, bstyle = bstyle,
          lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
          lvalign = lvalign, lstyle = lstyle,
          rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
          rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.summary.glm <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
  x <- as.data.frame(x$coef)
  obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
        include.colnames = include.colnames, rownames = rownames, colnames = colnames,
        format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
        caption = caption, caption.level = caption.level, width = width, frame = frame,
        grid = grid, valign = valign, header = header, footer = footer, align = align,
        col.width = col.width, style = style,
        tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
        tvalign = tvalign, tstyle = tstyle,
        bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
        bvalign = bvalign, bstyle = bstyle,
        lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
        lvalign = lvalign, lstyle = lstyle,
        rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
        rvalign = rvalign, rstyle = rstyle)
  class(obj) <- c("ascii", "proto", "environment")
  return(obj)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiHmisc.r"
# From Hmisc package
ascii.describe.single <- function (x, condense = TRUE, ...)
{
   wide <- .Options$width
    # des : le titre
    des <- x$descript
    if (length(x$units))
      des <- paste(des, " [", x$units, "]", sep = "")
        if (length(x$format))
          des <- paste(des, "  Format:", x$format, sep = "")
            dim.counts <- dim(x$count)
            if (is.null(dim.counts)) {counts <-as.character(x$count)} else {
            counts <- matrix(as.character(x$count), dim.counts[1], dim.counts[2])}
            names(counts) <- names(x$count)
            counts <- ascii(counts, include.colnames = TRUE, caption = des, caption.level = "s")
            val <- x$values
            if (length(val)) {
              if (!is.matrix(val)) {
                if (length(val) != 10 || !all(names(val) == c("L1",
                        "L2", "L3", "L4", "L5", "H5", "H4", "H3", "H2",
                        "H1"))) {
                  cat("\n")
                    val <- paste(names(val), ifelse(val > 1, paste(" (",
                            val, ")", sep = ""), ""), sep = "")
                    val <- strwrap(val, exdent = 4)
                    val <- as.list(sub('(^    )(.*)', '\t\\2', val))
                    val <- ascii(val, list.type = "none")
                }
                else {
                  if (condense) {
                    low <- paste("lowest:", paste(val[1:5], collapse = " "))
                      hi <- paste("highest:", paste(val[6:10], collapse = " "))
                      if (nchar(low) + nchar(hi) + 2 > wide)
                        val <- as.list(c(low, hi))
                      else val <- as.list(paste(low, hi, sep = ", "))
                    val <- ascii(val, list.type = "none")
                  }
                  else {
                    dim.val <- dim(val)
                    if (is.null(dim.val)) {val <- as.character(val)} else {
                    val <- matrix(as.character(val), dim.val[1], dim.val[2])}
                    names(val) <- names(x$values)
                    val <- ascii(val, include.colnames = TRUE)
                  }
                }
              }
              else {
                lev <- dimnames(val)[[2]]
                  if (condense && (mean(nchar(lev)) > 10 | length(lev) <
                        5)) {
                    z <- ""
                      len <- 0
                      for (i in 1:length(lev)) {
                        w <- paste(lev[i], " (", val[1, i], ", ", val[2,
                            i], "%)", sep = "")
                          if (i == 1) z <- w
                          else z <- paste(z, w, sep = ", ")
                  }
                  val <- ascii(as.list(z), list.type = "none")
                  }
                  else {
                    dim.val <- dim(val)
                    if (is.null(dim.val)) {val <- as.character(val)} else {
                    val <- matrix(as.character(val), dim.val[1], dim.val[2])}
                    rownames(val) <- rownames(x$values)
                    colnames(val) <- colnames(x$values)
                    val <- ascii(val, include.rownames = TRUE, include.colnames = TRUE)
                  }
              }
            }
#   if (length(x$mChoice)) {
#       print(x$mChoice, prlabel = FALSE)
#   }
  res <- asciiMixed$new(counts, val)
  class(res) <- c("ascii", "proto", "environment")
  return(res)
}

ascii.describe <- function (x, condense = TRUE, ...)
{
  at <- attributes(x)
  descrip <- ifelse(is.null(at$descript), "", at$descrip)
  if (is.null(at$dimensions[2])) {
    variable <- NULL
  } else {
    variable <- paste(at$dimensions[2], "Variable")
  }
  if (is.null(at$dimensions[1])) {
    observation <- NULL
  } else {
    observation <- paste(at$dimensions[1], "Observations")
  }
  if (!is.null(variable) | !is.null(observation) | descrip != "") {
    des <- ascii(list(variable, observation), caption = descrip, caption.level = "")
  } else {des <- NULL}
    if (length(at$dimensions)) {
      xx <- lapply(x, ascii.describe.single, condense = condense)
        res <- NULL
        for (z in 1:length(x)) {
          if (length(x[[z]]) == 0) next
          res <- asciiMixed$new(res, xx[[z]])
          class(res) <- c("ascii", "proto", "environment")
        }
    }
    else res <- ascii.describe.single(x, condense = condense)

  if (length(at$naprint)) { na <- ascii(as.list(at$naprint)) ; res <- asciiMixed$new(des, na, res) }
  else res <- asciiMixed$new(des, res)
  class(res) <- c("ascii", "proto", "environment")

  return(res)
}

# ascii.summary.formula.response <- function (x, vnames = c("labels", "names"), prUnits = TRUE, abbreviate.dimnames = FALSE,
#     prefix.width, min.colwidth, formatArgs = NULL, ...)
# {
#   stats <- x
#     stats <- oldUnclass(stats)
#     vnames <- match.arg(vnames)
#     ul <- vnames == "labels"
#     at <- attributes(stats)
#     ns <- length(at$strat.levels)
#     vlabels <- at$labels
#     if (prUnits) {
#       atu <- translate(at$units, "*", " ")
#         vlabels <- ifelse(atu == "", vlabels, paste(vlabels,
#               " [", atu, "]", sep = ""))
#     }
#   entete <- list(paste(at$ylabel, if (ns > 1)
#       paste(" by", if (ul)
#         at$strat.label
#         else at$strat.name), "    N=", at$n, if (at$nmiss)
#       paste(", ", at$nmiss, " Missing", sep = ""),
#       sep = ""))
#   entete <- ascii(entete, list.type = "none")
#     d <- dim(stats)
#     if (exists("print.char.matrix")) {
#       nr <- length(at$nlevels)
#         vlab <- if (ul)
#         at$vlabel
#         else at$vname
# #           z <- matrix("", nrow = nr, ncol = 1 + d[2], dimnames = list(vlab,
# #                 NULL))
#             dz <- dimnames(stats)[[1]]
#             cstats <- matrix("", nrow = d[1], ncol = d[2])
#             for (j in 1:d[2]) {
#               ww <- c(list(stats[, j]), formatArgs)
#                 cstats[, j] <- do.call("format", ww)
#                 cstats[is.na(stats[, j]), j] <- ""
#             }
#             z <- cbind(vlab, at$dimnames[[1]], cstats)
#             dimnames(z) <- list(NULL, c("", "", dimnames(stats)[[2]]))
#
# #         is <- 1
# #           for (i in 1:nr) {
# #             ie <- is + at$nlevels[i] - 1
# #               z[i, 1] <- paste(dz[is:ie], collapse = "\n")
# #               for (j in 1:d[2]) z[i, j + 1] <- paste(cstats[is:ie,
# #                   j], collapse = "\n")
# #                 is <- ie + 1
# #           }
# #         if (missing(prefix.width))
# #           prefix.width <- max(nchar(dimnames(z)[[1]]))
# #             if (missing(min.colwidth))
# #               min.colwidth <- max(min(nchar(cstats)[nchar(cstats) >
# #                     0]), min(nchar(dimnames(stats)[[2]])))
# #                 z <- rbind(c("", dimnames(stats)[[2]]), z)
# #                  print.char.matrix(z, col.names = FALSE, ...)
#                  tab <- ascii(z, include.colnames = TRUE)
#     }
# #   dz <- if (length(at$strat.levels) == 1)
# #     dimnames(stats)[[2]]
# #     else paste(rep(at$strat.levels, length = d[2]), dimnames(stats)[[2]],
# #         sep = ":")
# #       z <- matrix("", ncol = d[2] + 2, nrow = d[1], dimnames = list(rep("",
# #               d[1]), c("", "", dz)))
# #         z[, 1] <- if (ul)
# #         vlabels
# #         else at$vname
# #           z[, 2] <- dimnames(stats)[[1]]
# #             for (i in 1:d[2]) {
# #               ww <- c(list(stats[, i]), formatArgs)
# #                 z[, i + 2] <- do.call("format", ww)
# #             }
# #         print(z, quote = FALSE)
# #           invisible()
#   res <- asciiMixed$new(entete, tab)
#   class(res) <- c("ascii", "proto", "environment")
#   return(res)
#
# }
#
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiHtest.r"
ascii.htest <- function(x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
  if (x$method == "Fisher's Exact Test for Count Data") {
    res <- cbind(x$estimate, x$conf.int[1], x$conf.int[2], x$p.value)
    colnames(res) <- c("Odds ratio", "lower .95", "upper .95", "p-value")
  }
  if (x$method == "Pearson's Chi-squared test with Yates' continuity correction" | x$method == "Pearson's Chi-squared test" | x$method == "Chi-squared test for given probabilities"){
    res <- cbind(x$statistic, x$parameter, x$p.value)
    colnames(res) <- c("X-squared", "df", "p-value")
  }
  ascii(res, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiList.r"
ascii.list <- function(x, caption = "", caption.level = "", list.type = "bullet", ...) {
    obj <- asciiList$new(x = x, caption = caption, caption.level = caption.level, list.type = list.type)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.simple.list <- function(x, caption = "", caption.level = "", list.type = "label", ...) {
    x <- unlist(x)
    obj <- asciiList$new(x = x, caption = caption, caption.level = caption.level, list.type = list.type)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.packageDescription <- function(x, caption = "", caption.level = "", list.type = "label", ...) {
  x <- unclass(x)
#  x$File <- attributes(x)$file
  x <- lapply(x, function(x) gsub("\n", " ", x))
  obj <- asciiList$new(x = x, caption = caption, caption.level = caption.level, list.type = list.type)
  class(obj) <- c("ascii", "proto", "environment")
  return(obj)  
}

ascii.sessionInfo <- function (x, locale = TRUE, ...) {
  mkLabel <- function(L, n) {
    vers <- sapply(L[[n]], function(x) x[["Version"]])
    pkg <- sapply(L[[n]], function(x) x[["Package"]])
    paste(pkg, vers, sep = "_")
  }
  res <- NULL
  res$"R version" <- paste(x$R.version$version.string, x$R.version$platform, sep = ", ")
  if (locale)
    res$locale <- paste(strsplit(x$locale, ";", fixed = TRUE)[[1]], collapse = ", ")
  res$"attached base packages" <- paste(x$basePkgs, collapse = ", ")
  if (!is.null(x$otherPkgs))
    res$"other attached packages" <- paste(mkLabel(x, "otherPkgs"), collapse = ", ")
  if (!is.null(x$loadedOnly))
  res$"loaded via a namespace (and not attached)" <- paste(mkLabel(x, "loadedOnly"), collapse = ", ")

  res <- asciiList$new(x = res, caption = "", caption.level = "", list.type = "label")
  class(res) <- c("ascii", "proto", "environment")
  return(res)
}

#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiLm.r"
ascii.lm <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(summary(x)$coef)
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.summary.lm <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(x$coef)
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiMatrix.r"
ascii.matrix <- function (x, include.rownames = FALSE, include.colnames = FALSE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = FALSE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(x)
    obj <- asciiDataFrame$new(x, include.rownames,
         include.colnames, rownames, colnames, format,
         digits, decimal.mark, na.print,
         caption, caption.level, width, frame, grid,
         valign, header, footer, align,
         col.width, style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiPrcomp.r"
ascii.prcomp <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    y <- data.frame(x$rotation,check.names=FALSE)
    obj <- asciiDataFrame$new(y, include.rownames,
         include.colnames, rownames, colnames, format,
         digits, decimal.mark, na.print,
         caption, caption.level = caption.level, width, frame, grid,
         valign, header, footer, align,
         col.width, style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.summary.prcomp <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- data.frame(x$importance,check.names=FALSE)
    obj <- asciiDataFrame$new(x, include.rownames,
         include.colnames, rownames, colnames, format,
         digits, decimal.mark, na.print,
         caption, caption.level, width, frame, grid,
         valign, header, footer, align,
         col.width, style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiSmoothSpline.r"
ascii.smooth.spline <- function(x, caption = "", caption.level = "", list.type = "bullet", ...) {
    x <- as.list(capture.output(x)[-1:-3])
    obj <- asciiList$new(x = x, caption = caption, caption.level = caption.level, list.type = list.type)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiSummaryTable.r"
ascii.summary.table <- function(x, caption = "", caption.level = "", list.type = "bullet", ...) {
    x <- as.list(capture.output(x))
    obj <- asciiList$new(x = x, caption = caption, caption.level = caption.level, list.type = list.type)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiSurvival.r"
ascii.survdiff <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    # From print.survdiff
    if (length(x$n) == 1) {
        z <- sign(x$exp - x$obs) * sqrt(x$chisq)
        temp <- c(x$obs, x$exp, z, signif(1 - pchisq(x$chisq,
            1), digits))
        names(temp) <- c("Observed", "Expected", "Z", "p")
        temp <- t(temp)
        include.rownames = FALSE
    } else {
        if (is.matrix(x$obs)) {
            otmp <- apply(x$obs, 1, sum)
            etmp <- apply(x$exp, 1, sum)
        } else {
            otmp <- x$obs
            etmp <- x$exp
        }
        df <- c((sum(1 * (etmp > 0))) - 1, rep(NA, length(x$n) - 1))
        p <- c(1 - pchisq(x$chisq, df[!is.na(df)]), rep(NA, length(x$n) - 1))
        temp <- cbind(x$n, otmp, etmp, ((otmp - etmp)^2)/etmp,
            ((otmp - etmp)^2)/diag(x$var), df, p)
        dimnames(temp) <- list(names(x$n), c("N", "Observed",
            "Expected", "(O-E)^2/E", "(O-E)^2/V", "df", "p"))
    }

  temp <- as.data.frame(temp, checknames = FALSE)

  obj <- asciiDataFrame$new(x = temp, include.rownames = include.rownames,
      include.colnames = include.colnames, rownames = rownames, colnames = colnames,
      format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
      caption = caption, caption.level = caption.level, width = width, frame = frame,
      grid = grid, valign = valign, header = header, footer = footer, align = align,
      col.width = col.width, style = style,
      tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
      tvalign = tvalign, tstyle = tstyle,
      bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
      bvalign = bvalign, bstyle = bstyle,
      lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
      lvalign = lvalign, lstyle = lstyle,
      rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
      rvalign = rvalign, rstyle = rstyle)
  class(obj) <- c("ascii", "proto", "environment")
  return(obj)
}

ascii.survfit <- function (x, scale = 1, print.rmean = getOption("survfit.print.rmean"), rmean = getOption("survfit.rmean"), include.rownames = TRUE, include.colnames = TRUE, header = TRUE, ...) {
    omit <- x$na.action
    na <- NULL
    if (length(omit))
         na <- ascii(list(naprint(omit)), list.type = "none")
    if (!missing(print.rmean) && is.logical(print.rmean) && missing(rmean)) {
        if (print.rmean)
            rmean <- "common"
        else rmean <- "none"
    }
    if (is.null(rmean)) {
        if (is.logical(print.rmean)) {
            if (print.rmean)
                rmean <- "common"
            else rmean <- "none"
        }
        else rmean <- "none"
    }
    if (is.numeric(rmean)) {
        if (is.null(x$start.time)) {
            if (rmean < min(x$time))
                stop("Truncation point for the mean is < smallest survival")
        }
        else if (rmean < x$start.time)
            stop("Truncation point for the mean is < smallest survival")
    }
    else {
        rmean <- match.arg(rmean, c("none", "common", "individual"))
        if (length(rmean) == 0)
            stop("Invalid value for rmean option")
    }
    temp <- survival:::survmean(x, scale = scale, rmean)
    mat <- ascii(temp$matrix, include.rownames = include.rownames, include.colnames = include.colnames, header = header, ...)

    restrm <- NULL
    if (rmean != "none") {
        if (rmean == "individual")
            restrm <- ascii(list("* restricted mean with variable upper limit"))
        else restrm <- ascii(list(paste("* restricted mean with upper limit = ",
            format(temp$end.time[1]))))
    }
    obj <- asciiMixed$new(na, mat, restrm)
    class(obj) <- c("ascii", "proto", "environment")
    obj
}

ascii.summary.survfit <- function (x, include.colnames = TRUE, header = TRUE, digits = c(0, 0, 0, 3, 3, 3, 3), ...) {
  omit <- x$na.action
  na <- NULL
  if (length(omit)) 
    na <- ascii(list(naprint(omit)), list.type = "none")
  if (x$type == "right" || is.null(x$n.entered)) {
    mat <- cbind(x$time, x$n.risk, x$n.event, x$surv)
    cnames <- c("time", "n.risk", "n.event")
  } else if (x$type == "counting") {
    mat <- cbind(x$time, x$n.risk, x$n.event, x$n.enter, 
                 x$n.censor, x$surv)
    cnames <- c("time", "n.risk", "n.event", "entered", "censored")
  }
  if (is.matrix(x$surv)) {
    ncurve <- ncol(x$surv)
  } else ncurve <- 1
  if (ncurve == 1) {
    cnames <- c(cnames, "survival")
    if (!is.null(x$std.err)) {
      if (is.null(x$lower)) {
        mat <- cbind(mat, x$std.err)
        cnames <- c(cnames, "std.err")
      } else {
        mat <- cbind(mat, x$std.err, x$lower, x$upper)
        cnames <- c(cnames, "std.err", paste("lower ", 
                                             x$conf.int * 100, "% CI", sep = ""), paste("upper ", 
                                                                                        x$conf.int * 100, "% CI", sep = ""))
      }
    }
  } else cnames <- c(cnames, paste("survival", seq(ncurve), sep = ""))
  if (!is.null(x$start.time)) {
    mat.keep <- mat[, 1] >= x$start.time
    mat <- mat[mat.keep, , drop = FALSE]
    if (is.null(dim(mat))) 
      stop(paste("No information available using start.time =", 
                 x$start.time, "."))
  }
  if (!is.matrix(mat)) 
    mat <- matrix(mat, nrow = 1)
  if (!is.null(mat)) {
    dimnames(mat) <- list(NULL, cnames)
    if (is.null(x$strata)) {
      res <- ascii(mat, include.colnames = include.colnames, header = header, digits = digits, ...)
    } else {
      strata <- x$strata
      if (!is.null(x$start.time)) 
        strata <- strata[mat.keep]
      res <- NULL
      for (i in levels(strata)) {
        who <- (strata == i)
        res <- asciiMixed$new(res, ascii(mat[who, ], caption = i, include.colnames = include.colnames, header = header, digits = digits, ...))
        class(res) <- c("ascii", "proto", "environment")
      }
    }
  } else stop("There are no events to print.  Please use the option ", 
            "censored=TRUE with the summary function to see the censored ", 
            "observations.")
  obj <- asciiMixed$new(na, res)
  class(obj) <- c("ascii", "proto", "environment")
  return(obj)
}

# from xtable package
ascii.coxph <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){

    cox <- x
    beta <- cox$coef
    se <- sqrt(diag(cox$var))
    tmp <- cbind(beta, exp(beta), se, beta/se, 1 - pchisq((beta/se)^2, 1))
    dimnames(tmp) <- list(names(beta), c("coef", "exp(coef)", "se(coef)", "z", "p"))

    obj <- asciiDataFrame$new(x = as.data.frame(tmp), include.rownames = include.rownames,
      include.colnames = include.colnames, rownames = rownames, colnames = colnames,
      format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
      caption = caption, caption.level = caption.level, width = width, frame = frame,
      grid = grid, valign = valign, header = header, footer = footer, align = align,
      col.width = col.width, style = style,
      tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
      tvalign = tvalign, tstyle = tstyle,
      bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
      bvalign = bvalign, bstyle = bstyle,
      lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
      lvalign = lvalign, lstyle = lstyle,
      rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
      rvalign = rvalign, rstyle = rstyle)
  class(obj) <- c("ascii", "proto", "environment")
  return(obj)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiTable.r"
ascii.table <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){

  if (length(dim(x)) == 1 | is.null(dim(x))) {
    y <- as.data.frame(t(unclass(x)))
    names(y) <- names(x)
  }
  if (length(dim(x)) == 2) {
    y <- unclass(x)
    if (length(unique(rownames(y))) < nrow(y)) rownames(y) <- 1:nrow(y)
    y <- as.data.frame(y)
  }
  if (length(dim(x)) > 2)  y <- as.data.frame(x)

  obj <- ascii(x = y, include.rownames = include.rownames,
      include.colnames = include.colnames, rownames = rownames, colnames = colnames,
      format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
      caption = caption, caption.level = caption.level, width = width, frame = frame,
      grid = grid, valign = valign, header = header, footer = footer, align = align,
      col.width = col.width, style = style,
      tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
      tvalign = tvalign, tstyle = tstyle,
      bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
      bvalign = bvalign, bstyle = bstyle,
      lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
      lvalign = lvalign, lstyle = lstyle,
      rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
      rvalign = rvalign, rstyle = rstyle)
  class(obj) <- c("ascii", "proto", "environment")
  return(obj)
}

ascii.ftable <- function(x, digits = getOption("digits"), header = TRUE, ...) {
  ascii(format(x, quote = F, digits = digits), header = header)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiTs.r"
# from xtable package
ascii.ts <- function (x, include.rownames = TRUE, include.colnames = TRUE, rownames = NULL, colnames = NULL, format = "f", digits = 0, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = TRUE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){

  if (inherits(x, "ts") && !is.null(ncol(x))) {
    tp.1 <- trunc(time(x))
    tp.2 <- trunc(cycle(x))
    day.abb <- c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
    ROWNAMES <- switch(frequency(x),
        tp.1,
        "Arg2", "Arg3",              ## Dummy arguments
        paste(tp.1, c("Q1", "Q2", "Q3", "Q4")[tp.2], sep=" "),
        "Arg5", "Arg6",
        paste("Wk.", tp.1, " ", day.abb[tp.2], sep=""),
        "Arg8", "Arg9", "Arg10", "Arg11",
        paste(tp.1, month.abb[tp.2], sep=" "))
    tmp <- data.frame(x, row.names=ROWNAMES);
  }
  else if (inherits(x, "ts") && is.null(ncol(x))) {
    COLNAMES <- switch(frequency(x),
        "Value",
        "Arg2", "Arg3",              ## Dummy arguments
        c("Q1", "Q2", "Q3", "Q4"),
        "Arg5", "Arg6",
        day.abb,
        "Arg8", "Arg9", "Arg10", "Arg11",
        month.abb)
    ROWNAMES <- seq(from=start(x)[1], to=end(x)[1])
    tmp <- data.frame(matrix(c(rep(NA, start(x)[2] - 1), x,
              rep(NA, frequency(x) - end(x)[2])),
            ncol=frequency(x), byrow=TRUE), row.names=ROWNAMES)
    names(tmp) <- COLNAMES
  }
  obj <- asciiDataFrame$new(x = as.data.frame(tmp), include.rownames = include.rownames,
      include.colnames = include.colnames, rownames = rownames, colnames = colnames,
      format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
      caption = caption, caption.level = caption.level, width = width, frame = frame,
      grid = grid, valign = valign, header = header, footer = footer, align = align,
      col.width = col.width, style = style,
      tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
      tvalign = tvalign, tstyle = tstyle,
      bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
      bvalign = bvalign, bstyle = bstyle,
      lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
      lvalign = lvalign, lstyle = lstyle,
      rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
      rvalign = rvalign, rstyle = rstyle)
  class(obj) <- c("ascii", "proto", "environment")
  return(obj)
}

ascii.zoo <- function(x,...) {
    return(ascii(as.ts(x),...))
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/asciiVector.r"
ascii.integer <- function (x, include.rownames = FALSE, include.colnames = FALSE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = FALSE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(t(x))
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.numeric <- function (x, include.rownames = FALSE, include.colnames = FALSE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = FALSE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(t(x))
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.character <- function (x, include.rownames = FALSE, include.colnames = FALSE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = FALSE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(t(x))
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width,
         frame = frame, grid = grid, valign = valign, header = header, footer = footer,
         align = align, col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}

ascii.factor <- function (x, include.rownames = FALSE, include.colnames = FALSE, rownames = NULL, colnames = NULL, format = "f", digits = 2, decimal.mark = ".", na.print = "", caption = "", caption.level = "", width = 0, frame = "", grid = "", valign = "", header = FALSE, footer = FALSE, align = "", col.width = 1, style = "", tgroup = NULL, n.tgroup = NULL, talign = "", tvalign = "", tstyle = "", bgroup = NULL, n.bgroup = NULL, balign = "", bvalign = "", bstyle = "", lgroup = NULL, n.lgroup = NULL, lalign = "", lvalign = "", lstyle = "", rgroup = NULL, n.rgroup = NULL, ralign = "", rvalign = "", rstyle = "", ...){
    x <- as.data.frame(t(as.character(x)))
    obj <- asciiDataFrame$new(x = x, include.rownames = include.rownames,
         include.colnames = include.colnames, rownames = rownames, colnames = colnames,
         format = format, digits = digits, decimal.mark = decimal.mark, na.print = na.print,
         caption = caption, caption.level = caption.level, width = width, frame = frame,
         grid = grid, valign = valign, header = header, footer = footer, align = align,
         col.width = col.width, style = style,
         tgroup = tgroup, n.tgroup = n.tgroup, talign = talign,
         tvalign = tvalign, tstyle = tstyle,
         bgroup = bgroup, n.bgroup = n.bgroup, balign = balign,
         bvalign = bvalign, bstyle = bstyle,
         lgroup = lgroup, n.lgroup = n.lgroup, lalign = lalign,
         lvalign = lvalign, lstyle = lstyle,
         rgroup = rgroup, n.rgroup = n.rgroup, ralign = ralign,
         rvalign = rvalign, rstyle = rstyle)
    class(obj) <- c("ascii", "proto", "environment")
    return(obj)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/generic.r"
ascii <- function (x, ...) {
  require(proto)
  UseMethod("ascii")
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/misc.r"
############
# ASCIIDOC #
############
# generate column specifiers for asciidoc
cols <- function(ncol, align = "", col.width = 1, style = "") {

  if (align != "") {  
    align <- unlist(strsplit(align, ""))
    align <- rep(align, length.out = ncol)
    align[align == "l"] <- "<"
    align[align == "c"] <- "^"
    align[align == "r"] <- ">"
  }
  
  if (style != "") {
    style <- unlist(strsplit(style, ""))
    style <- rep(style, length.out = ncol)
  }
  if (sum(col.width) > length(col.width)) {
    col.width <- rep(col.width, length.out = ncol)
  }
  else col.width <- ""

  res <- paste(align, col.width, style, collapse = ",", sep = "")
  return(res)
}

cells.asciidoc <- function(span = "", align = "", valign = "", style = "") {
  
  if (align != "") {  
    align[align == "l"] <- "<"
    align[align == "c"] <- "^"
    align[align == "r"] <- ">"
  }

  if (valign != "") {  
    valign[valign == "top"]    <- ".<"
    valign[valign == "middle"] <- ".^"
    valign[valign == "bottom"] <- ".>"
  }
  
  res <- paste(span, align, valign, style, sep = "")
  return(res)
}

# generate headers for asciidoc
header.asciidoc <- function(caption = "", caption.level = "", frame = "", grid = "", valign = "", header = FALSE, footer = FALSE, cols = "", width = 0) {

  if (frame != "") frame <- paste('frame="', switch(frame, topbot = "topbot", sides = "sides", all = "all", none = "none"), '"', sep = "")
  if (grid != "") grid <- paste('grid="', switch(grid, all = "all", rows = "rows", cols = "cols", none = "none"), '"', sep = "")
  if (valign != "") valign <- paste('valign="', switch(valign, top = "top", bottom = "bottom", middle = "middle"), '"', sep = "")
  if (cols != "") cols <- paste('cols="', cols, '"', sep = "")
  if (width != 0) {
    width <- paste('width="', width, '%"', sep = "")
  }
  else width <- ""
  
  if (header | footer) {
    options <- 'options="'
    if (header & footer) options <- paste(options, 'header,footer', '"', sep = "")
    else if (header)     options <- paste(options, 'header', '"', sep = "")
    else if (footer)     options <- paste(options, 'footer', '"', sep = "")
  }
  else {options <- ""}
  
  listarg <- c(frame, grid, valign, options, cols, width)
  listarg <- listarg[listarg != ""]

  if (length(listarg) != 0) {
    res <- paste("[", paste(listarg, collapse = ","), "]\n", sep = "")
  } else res <- ""
  if (caption != "") {
    if (caption.level == "." | caption.level == "") res <- paste(".", caption, "\n", res, sep = "") 
    else if (is.numeric(caption.level) & caption.level > 0) { lev <- paste(rep("=", caption.level), collapse = "") ; res <- paste(lev, " ", caption, " ", "\n\n", res, sep = "") } 
    else if (caption.level == "s") res <- paste(beauty.asciidoc(caption, "s"), "\n\n", res, sep = "")
    else if (caption.level == "e") res <- paste(beauty.asciidoc(caption, "e"), "\n\n", res, sep = "")
    else if (caption.level == "m") res <- paste(beauty.asciidoc(caption, "m"), "\n\n", res, sep = "")
    else if (caption.level == "none") res <- paste(caption, "\n\n", res, sep = "") 
  }
  return(res)
}

# beautify for asciidoc
beauty.asciidoc <- function(x, beauti = c("e", "m", "s")) {
  if (beauti == "s") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("\\*.*\\*", x)+1)/2) # bold seulement si != de "" et si pas de bold
    if (length(x[!y]) != 0) x[!y] <- sub("(^ *)([:alpha]*)", "\\1\\*\\2", sub("([:alpha:]*)( *$)", "\\1\\*\\2", x[!y]))
  }
  if (beauti == "e") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("'.*'", x)+1)/2) # it seulement si != de "" et si pas de it
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1'\\2", sub("([:alpha:]*)( *$)", "\\1'\\2", x[!y])) 
  }
  if (beauti == "m") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("\\+.*\\+", x)+1)/2) # it seulement si != de "" et si pas de mono
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1\\+\\2", sub("([:alpha:]*)( *$)", "\\1\\+\\2", x[!y])) 
  }
  return(x)
}

############
# TXT2TAGS #
############

# generate headers for txt2tags
header.t2t <- function(caption = "", caption.level = "") {
  res <- ""
  if (caption != "") {
    if (is.numeric(caption.level) & caption.level > 0) { lev <- paste(rep("=", caption.level), collapse = "") ; res <- paste(lev, " ", caption, " ", lev, "\n\n", sep = "") }
    else if (caption.level == "s") res <- paste(beauty.t2t(caption, "s"), "\n\n", sep = "")
    else if (caption.level == "e") res <- paste(beauty.t2t(caption, "e"), "\n\n", sep = "")
    else if (caption.level == "m") res <- paste(beauty.t2t(caption, "m"), "\n\n", sep = "")
    else res <- paste(caption, "\n\n", sep = "") 
  }
  return(res)
}

# beautify for t2t
beauty.t2t <- function(x, beauti = c("e", "m", "s")) {
  if (beauti == "s") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("\\*\\*.*\\*\\*", x)+1)/2) # bold seulement si != de "" et si pas de bold
    if (length(x[!y]) != 0) x[!y] <- sub("(^ *)([:alpha]*)", "\\1\\*\\*\\2", sub("([:alpha:]*)( *$)", "\\1\\*\\*\\2", x[!y]))
  }
  if (beauti == "e") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("//.*//", x)+1)/2) # it seulement si != de "" et si pas de it
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1//\\2", sub("([:alpha:]*)( *$)", "\\1//\\2", x[!y])) 
  }
  if (beauti == "m") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("``.*``", x)+1)/2) # it seulement si != de "" et si pas de mono
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1``\\2", sub("([:alpha:]*)( *$)", "\\1``\\2", x[!y])) 
  }
  return(x)
}

########
# ReST #
########

# generate headers for rest
header.rest <- function(caption = "", caption.level = "") {
  niv <- c("=", "-", "~", "^", "+")
  ncharcap <- nchar(caption)
  res <- ""
  if (caption != "") {
    if (is.numeric(caption.level) & caption.level > 0) {
      res <- paste(caption, paste(paste(rep(niv[caption.level], ncharcap), collapse = ""), "\n", sep = ""), sep = "\n")
    } else if (is.character(caption.level) & caption.level %in% c("s", "e", "m")) {
      if (caption.level == "s")
        res <- paste(beauty.rest(caption, "s"), "\n\n", sep = "")
      else if (caption.level == "e")
        res <- paste(beauty.rest(caption, "e"), "\n\n", sep = "")
      else if (caption.level == "m")
        res <- paste(beauty.rest(caption, "m"), "\n\n", sep = "")
    } else if (is.character(caption.level) & caption.level != "" & caption.level != "none") {
      res <- paste(caption, paste(paste(rep(caption.level, ncharcap), collapse = ""), "\n", sep = ""), sep = "\n")
    } else if (caption.level == "" | caption.level == "none") {
      res <- paste(caption, "\n\n", sep = "")
    }
  } 
  return(res)
}
  
# beautify for rest
beauty.rest <- function(x, beauti = c("e", "m", "s")) {
  if (beauti == "s") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("\\*\\*.*\\*\\*", x)+1)/2) # bold seulement si != de "" et si pas de bold
    if (length(x[!y]) != 0) x[!y] <- sub("(^ *)([:alpha]*)", "\\1\\*\\*\\2", sub("([:alpha:]*)( *$)", "\\1\\*\\*\\2", x[!y]))
    if (length(x[y]) != 0) x[y] <- sub("(^ *$)", "\\1    ", x[y]) # rajouter suffisamment d'espaces lorsque la case est vide pour l'alignement globale
  }
  if (beauti == "e") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("\\*.*\\*", x)+1)/2) # it seulement si != de "" et si pas de it
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1\\*\\2", sub("([:alpha:]*)( *$)", "\\1\\*\\2", x[!y])) 
    if (length(x[y]) != 0) x[y] <- sub("(^ *$)", "\\1  ", x[y]) # rajouter suffisamment d'espaces lorsque la case est vide pour l'alignement globale
  }
  if (beauti == "m") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("``.*``", x)+1)/2) # it seulement si != de "" et si pas de mono
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1``\\2", sub("([:alpha:]*)( *$)", "\\1``\\2", x[!y])) 
    if (length(x[y]) != 0) x[y] <- sub("(^ *$)", "\\1    ", x[y]) # rajouter suffisamment d'espaces lorsque la case est vide pour l'alignement globale
  }
  return(x)
}

#######
# Org #
#######

# generate headers for org
header.org <- function(caption = "", caption.level = "") {
  res <- ""
  if (caption != "") {
    if (is.numeric(caption.level) & caption.level > 0) {
      res <- paste(paste(rep("*", caption.level), collapse = ""), caption, "\n")
    }
    else if (is.character(caption.level) & caption.level %in% c("s", "e", "m")) {
      if (caption.level == "s")
        res <- paste(beauty.org(caption, "s"), "\n", sep = "")
      else if (caption.level == "e")
        res <- paste(beauty.org(caption, "e"), "\n", sep = "")
      else if (caption.level == "m")
        res <- paste(beauty.org(caption, "m"), "\n", sep = "")
    } else if (caption.level == "none")
      res <- paste(caption, "\n", sep = "")
    else 
      res <- paste("#+CAPTION: ", caption, "\n", sep = "")
    }
  return(res)
}

# beautify for org
beauty.org <- function(x, beauti = c("e", "m", "s")) {
  if (beauti == "s") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("\\*.*\\*", x)+1)/2) # bold seulement si != de "" et si pas de bold
    if (length(x[!y]) != 0) x[!y] <- sub("(^ *)([:alpha]*)", "\\1\\*\\2", sub("([:alpha:]*)( *$)", "\\1\\*\\2", x[!y]))
    if (length(x[y]) != 0) x[y] <- sub("(^ *$)", "\\1  ", x[y]) # rajouter suffisamment d'espaces lorsque la case est vide pour l'alignement globale
  }
  if (beauti == "e") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("/.*/", x)+1)/2) # it seulement si != de "" et si pas de it
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1/\\2", sub("([:alpha:]*)( *$)", "\\1/\\2", x[!y])) 
    if (length(x[y]) != 0) x[y] <- sub("(^ *$)", "\\1  ", x[y]) # rajouter suffisamment d'espaces lorsque la case est vide pour l'alignement globale
  }
  if (beauti == "m") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("=.*=", x)+1)/2) # it seulement si != de "" et si pas de mono
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1=\\2", sub("([:alpha:]*)( *$)", "\\1=\\2", x[!y])) 
    if (length(x[y]) != 0) x[y] <- sub("(^ *$)", "\\1  ", x[y]) # rajouter suffisamment d'espaces lorsque la case est vide pour l'alignement globale
  }
  return(x)
}

###########
# TEXTILE #
###########
# generate headers for textile
header.textile <- function(caption = "", caption.level = "", frame = "", width = 0) {
  
  if (frame != "") {
    frame <- switch(frame, topbot = "border-top:1px solid black;border-bottom:1px solid black", sides = "border-left:1px solid black;border-right:1px solid black", all = "border:1px solid black", none = "")
  }

  if (width != 0) {
    width <- paste("width:", width, "%", sep = "")
  } else {
    width <- ""
  }

  listarg <- c(frame, width)
  listarg <- listarg[listarg != ""]

  if (length(listarg) != 0) {
    res <- paste("table{", paste(listarg, collapse = ";"), "}\n", sep = "")
  }
  else res <- ""

    if (caption != "") {
    if (is.numeric(caption.level) & caption.level > 0) { lev <- paste("h", caption.level, ".", sep = "") ; res <- paste(lev, " ", caption, " ", lev, "\n\n", sep = "") }
    else if (caption.level == "s") res <- paste(beauty.t2t(caption, "s"), "\n", sep = "")
    else if (caption.level == "e") res <- paste(beauty.t2t(caption, "e"), "\n", sep = "")
    else if (caption.level == "m") res <- paste(beauty.t2t(caption, "m"), "\n", sep = "")
    else res <- paste(caption, "\n", res, sep = "") 
  }

  return(res)
}

# beautify for textile
beauty.textile <- function(x, beauti = c("e", "m", "s", "header", "r", "c")) {
  if (beauti == "s") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("\\*.*\\*", x)+1)/2) # bold seulement si != de "" et si pas de bold
    if (length(x[!y]) != 0) x[!y] <- sub("(^ *)([:alpha]*)", "\\1\\*\\2", sub("([:alpha:]*)( *$)", "\\1\\*\\2", x[!y]))
  }
  if (beauti == "e") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("/.*/", x)+1)/2) # it seulement si != de "" et si pas de it
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1/\\2", sub("([:alpha:]*)( *$)", "\\1/\\2", x[!y])) 
  }
  if (beauti == "m") {
    y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("<code>.*</code>", x)+1)/2) # it seulement si != de "" et si pas de mono
    if (length(x[!y]) != 0) x[!y] <-sub("(^ *)([:alpha]*)", "\\1<code>\\2", sub("([:alpha:]*)( *$)", "\\1</code>\\2", x[!y])) 
  }
  ## if (beauti == "header") {
  ##   y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("_\\..*", x)+1)/2) # it seulement si != de "" et si pas de titre
  ##   if (length(x[!y]) != 0) x[!y] <- paste("_. ", x[!y], sep = "") 
  ## }
  ## if (beauti == "r") {
  ##   y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr(">\\..*", x)+1)/2) # it seulement si != de "" et si pas de r
  ##   if (length(x[!y]) != 0) x[!y] <- paste(">. ", x[!y], sep = "") 
  ## }
  ## if (beauti == "c") {
  ##   y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("=\\..*", x)+1)/2) # it seulement si != de "" et si pas de r
  ##   if (length(x[!y]) != 0) x[!y] <- paste("=. ", x[!y], sep = "") 
  ## }
  ## if (beauti == "l") {
  ##   y <- as.logical((regexpr("^ *$", x)+1)/2) | as.logical((regexpr("<\\..*", x)+1)/2) # it seulement si != de "" et si pas de r
  ##   if (length(x[!y]) != 0) x[!y] <- paste("<. ", x[!y], sep = "") 
  ## }
  return(x)
}

cells.textile <- function(span = "", align = "", valign = "", style = "") {

  if (align != "") {  
    align[align == "l"] <- "<"
    align[align == "c"] <- "="
    align[align == "r"] <- ">"
  }

  if (valign != "") {  
    valign[valign == "top"]    <- "^"
    valign[valign == "middle"] <- "-"
    valign[valign == "bottom"] <- "~"
  }

  if (style != "") {  
    style[style == "s"] <- "{font-weight:bold}"
    style[style == "e"] <- "{font-style:italic}"
    style[style == "m"] <- "{font-family:Monospace}"
  }
  res <- paste(span, align, valign, style, sep = "")
  return(res)
}
#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/print.r"
options(asciiType = "asciidoc")

print.ascii <- function(x, type = getOption("asciiType"), file = NULL, append = FALSE, escape = FALSE, list.escape = c("\\_", "\\^"), ...) {
  if (type == "asciidoc") res <- capture.output(x$show.asciidoc())
  if (type == "rest") res <- capture.output(x$show.rest())
  if (type == "org") res <- capture.output(x$show.org())
  if (type == "t2t") res <- capture.output(x$show.t2t())
  if (type == "textile") res <- capture.output(x$show.textile())

  if (escape) {
    for (i in list.escape)
      res <- gsub(i, paste("\\", i, sep = ""), res)
  }
  
  if (is.null(file)) {
    cat(res, sep = "\n")
  }
  else {
    if (append) op <- "a" else op <- "w"
    f <- file(file, op)
    writeLines(res, f)
    close(f)
  }
  invisible(x)
}

#line 1 "/private/var/folders/JA/JAolSeAcFueOWF1Uy33XRk+++TI/-Tmp-/RtmpYyuhZz/R.INSTALL10d63af1/ascii/R/show.r"
require(proto)

asciiDataFrame <- proto(expr = {
  new <- function(.,
    x,
    include.rownames,
    include.colnames,
    rownames,
    colnames,
    format,
    digits,
    decimal.mark,
    na.print,
    caption,
    caption.level,
    width,
    frame,
    grid,
    valign,
    header,
    footer,
    align,
    col.width,
    style,
    tgroup,
    n.tgroup,
    talign,
    tvalign,
    tstyle,
    bgroup,
    n.bgroup,
    balign,
    bvalign,
    bstyle,
    lgroup,
    n.lgroup,
    lalign,
    lvalign,
    lstyle,
    rgroup,
    n.rgroup,
    ralign,
    rvalign,
    rstyle) proto(.,
    x = x,
    include.rownames = include.rownames,
    include.colnames = include.colnames,
    rownames = rownames,
    colnames = colnames,
    format = format,
    digits = digits,
    decimal.mark = decimal.mark,
    na.print = na.print,
    caption = caption,
    caption.level = caption.level, 
    width = width,
    frame = frame,
    grid = grid,
    valign = valign,
    header = header,
    footer = footer,
    align = align,
    col.width = col.width,
    style = style,
    tgroup = tgroup,
    n.tgroup = n.tgroup,
    talign = talign,
    tvalign = tvalign,
    tstyle = tstyle, 
    bgroup = bgroup,
    n.bgroup = n.bgroup,
    balign = balign,
    bvalign = bvalign,
    bstyle = bstyle, 
    lgroup = lgroup,
    n.lgroup = n.lgroup,
    lalign = lalign,
    lvalign = lvalign,
    lstyle = lstyle,
    rgroup = rgroup,
    n.rgroup = n.rgroup,
    ralign = ralign,
    rvalign = rvalign,
    rstyle = rstyle
)

  charac <- function(.) {
    # detection des colonnes numeriques
    numerics <- sapply(.$x, is.numeric)
    # adaption de certains parametres
    # format <- unlist(strsplit(format, "")) # No, format could be "fg" -> must be a vector
    if (!is.matrix(.$format)) format <- t(matrix(rep(.$format, length.out = ncol(.$x)), ncol(.$x), nrow(.$x), F))
    else format <- apply(t(apply(.$format, 1, rep, length = ncol(.$x))), 2, rep, length = nrow(.$x))
#    digits <- rep(.$digits, length.out = ncol(.$x))
    if (!is.matrix(.$digits)) digits <- t(matrix(rep(.$digits, length.out = ncol(.$x)), ncol(.$x), nrow(.$x), F))
    else digits <- apply(t(apply(.$digits, 1, rep, length = ncol(.$x))), 2, rep, length = nrow(.$x))
 
    # transformation de toute la dataframe en caracteres
    charac.x <- apply(format(.$x, trim = T), 2, as.character)
    if (is.vector(charac.x)) charac.x <- t(charac.x) # si une seule dimension

    charac.x <- as.data.frame(charac.x, , stringsAsFactors = F)

    # rownames and colnames
    if (!is.null(.$rownames)) {
      rownames(.$x) <- rep(.$rownames, length.out = nrow(.$x))
    }
    if (!is.null(.$colnames)) {
      colnames(.$x) <- rep(.$colnames, length.out = ncol(.$x))
    }
    
    rnoms <- rownames(.$x)
    cnoms <- names(.$x)
    if (.$include.rownames) {
      charac.x <- data.frame(rnoms, charac.x, stringsAsFactors = F)
      cnoms <- c("", cnoms)

      # adaptation de certains parametres
      format <- cbind("f", format)
      digits <- cbind(0, digits)
      numerics <- c(FALSE, numerics)
    }
    if (.$include.colnames) {
      names(cnoms) <- names(charac.x) # for following rbind
      charac.x <- rbind(data.frame(as.list(cnoms), stringsAsFactors = FALSE, check.names = FALSE), charac.x)
    }

    # Beautify cols (digits, format, spacing, na.print)
    replacement <- paste("\\1", .$na.print, "\\3", sep = "")
    for (i in 1:ncol(charac.x)) {
      if (numerics[i]) {
        charac.x[, i][charac.x[, i] == "NA"] <- "" # necessaire avant le formatage des nombres avec formatC(as.numeric(...))
        if (.$include.colnames)  charac.x[2:nrow(charac.x),i] <- apply(as.matrix(as.numeric(charac.x[2:nrow(charac.x),i])), 2, Vectorize(formatC), digits = digits[,i], format = format[,i], decimal.mark = .$decimal.mark)
        if (!.$include.colnames)  charac.x[,i] <- apply(as.matrix(as.numeric(charac.x[,i])), 2, Vectorize(formatC), digits = digits[,i], format = format[,i], decimal.mark = .$decimal.mark)
      }
      charac.x[,i] <- sub("(^ *)(NA)( *$)", replacement, charac.x[,i])
      charac.x[,i] <- format(charac.x[,i], justify = "left")
      charac.x[,i] <- gsub("\\|", "\\\\|", charac.x[,i])
    }
    return(charac.x)
  }

  show.asciidoc <- function(.) {
    charac.x <- charac(.)
    if (.$align != "") {  
      align <- unlist(strsplit(.$align, ""))
      align <- rep(align, length.out = ncol)
    } else align = .$align

    if (.$valign != "") {  
      valign <- rep(.$valign, length.out = ncol)
    } else valign = .$valign
    
    if (.$style != "") {
      style <- unlist(strsplit(.$style, ""))
      style <- rep(style, length.out = ncol(charac.x))
    } else style = .$style
    
    rows <- apply(charac.x, 1, function(x) paste(paste("", Vectorize(cells.asciidoc)(align = align, valign = valign, style = style), "| ", x, sep = ""), collapse = " "))

    if (!is.null(.$lgroup)) {
      lgroup <- .$lgroup
      n.lgroup <- .$n.lgroup
      if (is.null(n.lgroup))
        lgroup <- lgroup[1]
      
      n.lgroup <- rep(n.lgroup, length.out = length(lgroup))
      if (sum(n.lgroup) != nrow(charac.x)) {
        if (is.null(n.lgroup)) {
          n.lgroup <- nrow(charac.x)
        } else {
          n.lgroup[length(n.lgroup)] <- n.lgroup[length(n.lgroup)] + nrow(charac.x) - sum(n.lgroup)
        }
      }
      pos.lgroup <- c(1, 1+cumsum(n.lgroup))[1:length(n.lgroup)]
      rows[pos.lgroup] <- paste(paste(cells.asciidoc(span = paste(".", n.lgroup, "+", sep = ""), align = .$lalign, valign = .$lvalign, style = .$lstyle), lgroup, sep = "| "), rows[pos.lgroup], sep = " ")
    }

    if (!is.null(.$rgroup)) {
      rgroup <- .$rgroup
      n.rgroup <- .$n.rgroup
      if (is.null(n.rgroup))
        rgroup <- rgroup[1]
      
      n.rgroup <- rep(n.rgroup, length.out = length(rgroup))
      if (sum(n.rgroup) != nrow(charac.x)) {
        if (is.null(n.rgroup)) {
          n.rgroup <- nrow(charac.x)
        } else {
          n.rgroup[length(n.rgroup)] <- n.rgroup[length(n.rgroup)] + nrow(charac.x) - sum(n.rgroup)
        }
      }
      pos.rgroup <- c(1, 1+cumsum(n.rgroup))[1:length(n.rgroup)]
      rows[pos.rgroup] <- paste(rows[pos.rgroup], paste(cells.asciidoc(span = paste(".", n.rgroup, "+", sep = ""), align = .$ralign, valign = .$rvalign, style = .$rstyle), rgroup, sep = "| "), sep = " ")
    }

    if (sum(.$col.width) > length(.$col.width)) {
      col.width <- paste(rep(.$col.width, length.out = ncol(charac.x) + !is.null(.$lgroup) + !is.null(.$rgroup)), collapse = ",")
    } else col.width <- ""
    
    maxchars <- max(nchar(rows)) - 1

    topbot <- paste("|", paste(rep("=", maxchars), collapse = ""), sep = "")
    cat(header.asciidoc(caption = .$caption, caption.level = .$caption.level, frame = .$frame, grid = .$grid, valign = .$valign, header = .$header, footer = .$footer, cols = col.width, width = .$width))

    cat(topbot, "\n")
    if (!is.null(.$tgroup)) {
      tgroup <- .$tgroup
      n.tgroup <- .$n.tgroup
      if (is.null(n.tgroup))
        tgroup <- tgroup[1]
      n.tgroup <- rep(n.tgroup, length.out = length(.$tgroup))
      if (is.null(n.tgroup))
        n.tgroup <- 0
      if (!is.null(.$lgroup)) {
        tgroup <- c("", tgroup)
        n.tgroup <- c(1, n.tgroup)
      }
      if (!is.null(.$rgroup)) {
        tgroup <- c(tgroup, "")
        n.tgroup <- c(n.tgroup, 1)
      }
      if (sum(n.tgroup) != ncol(charac.x)) {
        n.tgroup[length(n.tgroup)] <- n.tgroup[length(n.tgroup)] + ncol(charac.x) - sum(n.tgroup) + !is.null(.$lgroup) + !is.null(.$rgroup)
      }
      cat(paste(cells.asciidoc(span = paste(n.tgroup, "+", sep = ""), align = .$talign, valign = .$tvalign, style = .$tstyle), tgroup, sep = "| "), "\n")
    }
    
    cat(rows, sep = "\n")

    if (!is.null(.$bgroup)) {
      bgroup <- .$bgroup
      n.bgroup <- .$n.bgroup
      if (is.null(n.bgroup))
        bgroup <- bgroup[1]
      n.bgroup <- rep(n.bgroup, length.out = length(.$bgroup))
      if (is.null(n.bgroup))
        n.bgroup <- 0
      if (!is.null(.$lgroup)) {
        bgroup <- c("", bgroup)
        n.bgroup <- c(1, n.bgroup)
      }
      if (!is.null(.$rgroup)) {
        bgroup <- c(bgroup, "")
        n.bgroup <- c(n.bgroup, 1)
      }
      if (sum(n.bgroup) != ncol(charac.x)) {
        n.bgroup[length(n.bgroup)] <- n.bgroup[length(n.bgroup)] + ncol(charac.x) - sum(n.bgroup) + !is.null(.$lgroup) + !is.null(.$rgroup)
      }
      cat(paste(cells.asciidoc(span = paste(n.bgroup, "+", sep = ""), align = .$balign, valign = .$bvalign, style = .$bstyle), bgroup, sep = "| "), "\n")
    }
    cat(topbot, "\n")
  }

  show.rest <- function(.) { # Manque la classe pour les listes et les mixtes
    # L'alignement et footer ne sont pas gérés

    charac.x <- charac(.)
    nrowx <- nrow(charac.x)
    ncolx <- ncol(charac.x)

    if (.$style != "") {  
      style <- unlist(strsplit(.$style, ""))
      style <- rep(style, length.out = ncolx)
      for (i in 1:ncolx) {
        charac.x[,i] <- beauty.rest(charac.x[,i], style[i])
      }
    }

    tgroup <- .$tgroup
    bgroup <- .$bgroup
    lgroup <- .$lgroup
    rgroup <- .$rgroup
    
    if (.$tstyle != "")
      tgroup <- beauty.rest(tgroup, .$tstyle)
    if (.$bstyle != "")
      bgroup <- beauty.rest(bgroup, .$bstyle)
    if (.$lstyle != "")
      lgroup <- beauty.rest(lgroup, .$lstyle)
    if (.$rstyle != "")
      rgroup <- beauty.rest(rgroup, .$rstyle)

    
    ncharcell <- nchar(charac.x[1,]) + 2

    if (!is.null(tgroup)) {
      n.tgroup <- .$n.tgroup
      if (is.null(n.tgroup))
        tgroup <- tgroup[1]
      n.tgroup <- rep(n.tgroup, length.out = length(tgroup))
      if (sum(n.tgroup) != ncol(charac.x)) {
        if (is.null(n.tgroup)) {
          n.tgroup <- ncol(charac.x)# + !is.null(lgroup)
        } else {
          n.tgroup[length(n.tgroup)] <- n.tgroup[length(n.tgroup)] + ncol(charac.x) - sum(n.tgroup)# + !is.null(lgroup)
        }
      }
      newtgroup <- NULL
      for (i in 1:length(tgroup))
        newtgroup <- c(newtgroup, tgroup[i], rep("", n.tgroup[i] - 1))

      names(newtgroup) <- names(charac.x) # for following rbind
      charac.x <- rbind(data.frame(as.list(newtgroup), stringsAsFactors = FALSE, check.names = FALSE), charac.x)
      charac.x <- format(charac.x, justify = "left")
      newtgroup <- as.character(charac.x[1,])
      charac.x <- charac.x[-1,]
      
      tcell <- cbind(cumsum(n.tgroup) - n.tgroup + 1, cumsum(n.tgroup))
      trows <- "|"
      for (i in 1:length(tgroup))
        trows <- paste(trows, paste(paste(newtgroup[unique(tcell[i,1]:tcell[i,2])], collapse = "   "), "|", collapse = " "), sep = " ")
      
      ncharcell <- nchar(charac.x[1,]) + 2

      tncharcell <- apply(cbind(cumsum(n.tgroup) - n.tgroup + 1, cumsum(n.tgroup), n.tgroup - 1), 1, function(x) sum(ncharcell[unique(x[1:2])[1]:unique(x[1:2])[length(unique(x[1:2]))]] ) + x[3])
      tinterrows <- paste("+", paste(sapply(tncharcell, function(x) paste(rep("-", x), collapse = "")), collapse = "+"), "+", sep = "")
    }

    if (!is.null(bgroup)) {
      n.bgroup <- .$n.bgroup
      if (is.null(n.bgroup))
        bgroup <- bgroup[1]
      n.bgroup <- rep(n.bgroup, length.out = length(bgroup))
      if (sum(n.bgroup) != ncol(charac.x)) {
        if (is.null(n.bgroup)) {
          n.bgroup <- ncol(charac.x)# + !is.null(lgroup)
        } else {
          n.bgroup[length(n.bgroup)] <- n.bgroup[length(n.bgroup)] + ncol(charac.x) - sum(n.bgroup)# + !is.null(lgroup)
        }
      }
      newbgroup <- NULL
      for (i in 1:length(bgroup))
        newbgroup <- c(newbgroup, bgroup[i], rep("", n.bgroup[i] - 1))

      names(newbgroup) <- names(charac.x) # for following rbind
      charac.x <- rbind(apply(charac.x, 2, as.character), data.frame(as.list(newbgroup), stringsAsFactors = FALSE, check.names = FALSE))
      charac.x <- format(charac.x, justify = "left")
      newbgroup <- as.character(charac.x[nrow(charac.x),])
      charac.x <- charac.x[-nrow(charac.x),]
      
      bcell <- cbind(cumsum(n.bgroup) - n.bgroup + 1, cumsum(n.bgroup))
      brows <- "|"
      for (i in 1:length(bgroup))
        brows <- paste(brows, paste(paste(newbgroup[unique(bcell[i,1]:bcell[i,2])], collapse = "   "), "|", collapse = " "), sep = " ")
      
      ncharcell <- nchar(charac.x[1,]) + 2

      bncharcell <- apply(cbind(cumsum(n.bgroup) - n.bgroup + 1, cumsum(n.bgroup), n.bgroup - 1), 1, function(x) sum(ncharcell[unique(x[1:2])[1]:unique(x[1:2])[length(unique(x[1:2]))]] ) + x[3])
      binterrows <- paste("+", paste(sapply(bncharcell, function(x) paste(rep("-", x), collapse = "")), collapse = "+"), "+", sep = "")
    }
    
    rows <- apply(charac.x, 1, function(x) paste("|", paste(paste(x, " |", sep = ""), collapse = " ")))
    
    interrows <- rep(paste("+", paste(sapply(ncharcell, function(x) paste(rep("-", x), collapse = "")), collapse = "+"), "+", sep = ""), nrowx+1)
    
    if (!is.null(tgroup)) {
      interrows <- c(tinterrows, interrows)
      rows <- c(trows, rows)
    }
    if (!is.null(bgroup)) {
      interrows <- c(interrows, binterrows)
      rows <- c(rows, brows)
    }
    
    if (!is.null(lgroup)) {
      n.lgroup <- .$n.lgroup
      if (is.null(n.lgroup))
        lgroup <- lgroup[1]
      n.lgroup <- rep(n.lgroup, length.out = length(lgroup))
      if (is.null(n.lgroup))
        n.lgroup <- 0
      if (sum(n.lgroup) != nrow(charac.x)) {
        n.lgroup[length(n.lgroup)] <- n.lgroup[length(n.lgroup)] + nrow(charac.x) - sum(n.lgroup)# + !is.null(tgroup) + !is.null(bgroup)
      }
      if (!is.null(tgroup)) {
        lgroup <- c("", lgroup)
        n.lgroup <- c(1, n.lgroup)
      }
      if (!is.null(bgroup)) {
        lgroup <- c(lgroup, "")
        n.lgroup <- c(n.lgroup, 1)
      }
      newlgroup <- rep("", sum(n.lgroup))
      lcell <- cumsum(c(1, n.lgroup[-length(n.lgroup)]))
      newlgroup[lcell] <- lgroup
      lrows <- paste("| ", format(newlgroup), " ", sep = "")
      lncharcell <- max(nchar(newlgroup)) + 2
      linterrows <- paste("+", paste(sapply(lncharcell, function(x) paste(rep("-", x), collapse = "")), collapse = "+"), sep = "")
      nolinterrows <- gsub("-", " ", linterrows)
      
      rows <- paste(lrows, rows, sep = "")
      tmp <- linterrows
      for (i in n.lgroup) {
        if (i == 1)
          linterrows <- c(linterrows, tmp)
        if (i > 1)
          linterrows <- c(linterrows, rep(nolinterrows, i-1), tmp)
      }
      interrows <- paste(linterrows, interrows, sep = "")
    }

    if (!is.null(rgroup)) {
      n.rgroup <- .$n.rgroup
      if (is.null(n.rgroup))
        rgroup <- rgroup[1]
      n.rgroup <- rep(n.rgroup, length.out = length(rgroup))
      if (is.null(n.rgroup))
        n.rgroup <- 0
      if (sum(n.rgroup) != nrow(charac.x)) {
        n.rgroup[length(n.rgroup)] <- n.rgroup[length(n.rgroup)] + nrow(charac.x) - sum(n.rgroup)# + !is.null(tgroup) + !is.null(bgroup)
      }
      if (!is.null(tgroup)) {
        rgroup <- c("", rgroup)
        n.rgroup <- c(1, n.rgroup)
      }
      if (!is.null(bgroup)) {
        rgroup <- c(rgroup, "")
        n.rgroup <- c(n.rgroup, 1)
      }
      newrgroup <- rep("", sum(n.rgroup))
      rcell <- cumsum(c(1, n.rgroup[-length(n.rgroup)]))
      newrgroup[rcell] <- rgroup
      rrows <- paste(" ", format(newrgroup), " |", sep = "")
      rncharcell <- max(nchar(newrgroup)) + 2
      rinterrows <- paste(paste(sapply(rncharcell, function(x) paste(rep("-", x), collapse = "")), collapse = "+"), "+", sep = "")
      norinterrows <- gsub("-", " ", rinterrows)
      
      rows <- paste(rows, rrows, sep = "")
      tmp <- rinterrows
      for (i in n.rgroup) {
        if (i == 1)
          rinterrows <- c(rinterrows, tmp)
        if (i > 1)
          rinterrows <- c(rinterrows, rep(norinterrows, i-1), tmp)
      }
      interrows <- paste(interrows, rinterrows, sep = "")
    }

    if (.$header)
      interrows[2] <- gsub("-", "=", interrows[2])

    cat(header.rest(caption = .$caption, caption.level = .$caption.level))    
    cat(c(rbind(interrows[-length(interrows)], rows), interrows[length(interrows)]), sep = "\n")
  }

  show.org <- function(.) {
    charac.x <- charac(.)
    ncolx <- ncol(charac.x)
    
    if (.$style != "") {  
      style <- unlist(strsplit(.$style, ""))
      style <- rep(style, length.out = ncolx)
      for (i in 1:ncolx) {
        charac.x[,i] <- beauty.org(charac.x[,i], style[i])
      }
    }
    
    ncharcell <- nchar(charac.x[1,]) + 2
    
    rows <- apply(charac.x, 1, function(x) paste("|", paste(paste(x, " |", sep = ""), collapse = " ")))
    
    interrow <- paste("|", paste(sapply(ncharcell, function(x) paste(rep("-", x), collapse = "")), collapse = "+"), "+", sep = "")
    
    if (.$header)
      rows <- c(rows[1], interrow, rows[-1])

    cat(header.org(caption = .$caption, caption.level = .$caption.level))    
    cat(interrow, "\n", sep = "")
    cat(rows, sep = "\n")
    cat(interrow, "\n", sep = "")
  }
  
  show.t2t <- function(.) {
    charac.x <- charac(.)
    # prise en compte du style
    if (.$style != "") {  
      style <- unlist(strsplit(.$style, ""))
      style <- rep(style, length.out = ncol(charac.x))
      for (i in 1:ncol(charac.x)) {
        charac.x[,i] <- beauty.t2t(charac.x[,i], style[i])
      }
    }

    # prise en compte de tgroup
    if (!is.null(.$tgroup)) {
      n.tgroup <- .$n.tgroup
      n.tgroup <- rep(n.tgroup, length.out = length(.$tgroup))
      if (sum(n.tgroup) != ncol(charac.x)) {
        if (is.null(n.tgroup)) {
          n.tgroup <- ncol(charac.x)
        } else {
          n.tgroup[length(n.tgroup)] <- n.tgroup[length(n.tgroup)] + ncol(charac.x) - sum(n.tgroup)
        }
      }
      tgroup <- .$tgroup
      if (.$tstyle != "") {
        tstyle <- rep(unlist(strsplit(.$tstyle, "")), length.out = length(tgroup))
        tgroup <- Vectorize(beauty.t2t)(tgroup, tstyle)
      }
      if (.$talign != "") {
        talign <- rep(unlist(strsplit(.$talign, "")), length.out = length(tgroup))
        for (i in 1:length(tgroup)) {
          if (talign[i] == "c")
            tgroup[i] <- paste(" ", tgroup[i], " ", collapse = "")
          if (talign[i] == "r")
            tgroup[i] <- paste(" ", tgroup[i], collapse = "")
        }
      }
      newtgroup <- paste("|", paste(paste(tgroup, lapply(n.tgroup, function(x) paste(rep("|", time = x), collapse = ""))), collapse = " "))
    }

    # prise en compte de bgroup
    if (!is.null(.$bgroup)) {
      n.bgroup <- .$n.bgroup
      n.bgroup <- rep(n.bgroup, length.out = length(.$bgroup))
      if (sum(n.bgroup) != ncol(charac.x)) {
        if (is.null(n.bgroup)) {
          n.bgroup <- ncol(charac.x)
        } else {
          n.bgroup[length(n.bgroup)] <- n.bgroup[length(n.bgroup)] + ncol(charac.x) - sum(n.bgroup)
        }
      }
      bgroup <- .$bgroup
      if (.$bstyle != "") {
        bstyle <- rep(unlist(strsplit(.$bstyle, "")), length.out = length(bgroup))
        bgroup <- Vectorize(beauty.t2t)(bgroup, bstyle)
      }
      if (.$balign != "") {
        balign <- rep(unlist(strsplit(.$balign, "")), length.out = length(bgroup))
        for (i in 1:length(bgroup)) {
          if (balign[i] == "c")
            bgroup[i] <- paste(" ", bgroup[i], " ", collapse = "")
          if (balign[i] == "r")
            bgroup[i] <- paste(" ", bgroup[i], collapse = "")
        }
      }
      newbgroup <- paste("|", paste(paste(bgroup, lapply(n.bgroup, function(x) paste(rep("|", time = x), collapse = ""))), collapse = " "))
    }

    # prise en compte de l'alignement
    if (.$align != "") {  
      align <- unlist(strsplit(.$align, ""))
      align <- rep(align, length.out = ncol(charac.x))
      for (i in 1:ncol(charac.x)) {
        for (j in 1:nrow(charac.x)) {
          if (length(grep("^ *$", charac.x[j, i])) == 0) {
            if (align[i] == "c") { charac.x[j, i] <- sub("^ *", " ", charac.x[j, i]) ; charac.x[j, i] <- sub(" *$", " ", charac.x[j, i]) }
            if (align[i] == "r") { charac.x[j, i] <- sub("^ *", " ", charac.x[j, i]) ; charac.x[j, i] <- sub(" *$", "", charac.x[j, i]) } 
          }
        }
      }
    }
    rows <- apply(charac.x, 1, function(x) paste("| ", paste(x, collapse = " | "), sep = ""))
    # cat result
    if (!is.null(.$tgroup)) {
      if (.$header)
        cat("|", sep = "")
      cat(newtgroup, "\n")
    }
    if (.$header & is.null(.$tgroup)) {
      rows[1] <- paste("|", rows[1], sep = "")
    }
    if (.$footer & is.null(.$bgroup)) {
      rows[length(rows)] <- paste("|", rows[length(rows)], sep = "")
    }
    if (.$frame == "" | .$frame == "all") rows <- paste(rows, " |", sep = "")
    cat(header.t2t(caption = .$caption, caption.level = .$caption.level))
    cat(rows, sep = "\n")
    if (!is.null(.$bgroup)) {
      if (.$footer)
        cat("|", sep = "")
      cat(newbgroup, "\n")
    }
  }

  show.textile <- function(.) {
    charac.x <- charac(.)
    if (.$align != "") {  
      align <- unlist(strsplit(.$align, ""))
      align <- rep(align, length.out = ncol)
    } else align = .$align

    if (.$valign != "") {  
      valign <- rep(.$valign, length.out = ncol)
    } else valign = .$valign

    if (.$style != "") {
      style <- unlist(strsplit(.$style, ""))
      style <- rep(style, length.out = ncol(charac.x))
    } else style = .$style
   
    rows <- paste(apply(charac.x, 1, function(x) paste(paste("|", Vectorize(cells.textile)(align = align, valign = valign, style = style), ". ", x, sep = ""), collapse = " ")), "|")

    if (.$header) {
      rows[1] <- gsub("\\|", "\\|_", rows[1])
      rows[1] <- sub("\\|_$", "\\|", rows[1])
    }
    if (.$footer) {
      rows[length(rows)] <- gsub("\\|", "\\|_", rows[length(rows)])
      rows[length(rows)] <- sub("\\|_$", "\\|", rows[length(rows)])
    }
    
    if (!is.null(.$lgroup)) {
      lgroup <- .$lgroup
      n.lgroup <- .$n.lgroup
      if (is.null(n.lgroup))
        lgroup <- lgroup[1]
      
      n.lgroup <- rep(n.lgroup, length.out = length(lgroup))
      if (sum(n.lgroup) != nrow(charac.x)) {
        if (is.null(n.lgroup)) {
          n.lgroup <- nrow(charac.x)
        } else {
          n.lgroup[length(n.lgroup)] <- n.lgroup[length(n.lgroup)] + nrow(charac.x) - sum(n.lgroup)
        }
      }
      pos.lgroup <- c(1, 1+cumsum(n.lgroup))[1:length(n.lgroup)]
      rows[pos.lgroup] <- paste(paste(cells.textile(span = paste("|/", n.lgroup, sep = ""), align = .$lalign, valign = .$lvalign, style = .$lstyle), lgroup, sep = ". "), rows[pos.lgroup], sep = " ")
    }

    if (!is.null(.$rgroup)) {
      rgroup <- .$rgroup
      n.rgroup <- .$n.rgroup
      if (is.null(n.rgroup))
        rgroup <- rgroup[1]
      
      n.rgroup <- rep(n.rgroup, length.out = length(rgroup))
      if (sum(n.rgroup) != nrow(charac.x)) {
        if (is.null(n.rgroup)) {
          n.rgroup <- nrow(charac.x)
        } else {
          n.rgroup[length(n.rgroup)] <- n.rgroup[length(n.rgroup)] + nrow(charac.x) - sum(n.rgroup)
        }
      }
      pos.rgroup <- c(1, 1+cumsum(n.rgroup))[1:length(n.rgroup)]
      rows[pos.rgroup] <- paste(rows[pos.rgroup], paste(cells.textile(span = paste("/", n.rgroup, sep = ""), align = .$ralign, valign = .$rvalign, style = .$rstyle), rgroup, sep = ". "), " |", sep = "")
    }

    ## if (sum(.$col.width) > length(.$col.width)) {
    ##   col.width <- paste(rep(.$col.width, length.out = ncol(charac.x) + !is.null(.$lgroup) + !is.null(.$rgroup)), collapse = ",")
    ## } else col.width <- ""
    
    maxchars <- max(nchar(rows)) - 1

    cat(header.textile(caption = .$caption, caption.level = .$caption.level, frame = .$frame, width = .$width))

    if (!is.null(.$tgroup)) {
      tgroup <- .$tgroup
      n.tgroup <- .$n.tgroup
      if (is.null(n.tgroup))
        tgroup <- tgroup[1]
      n.tgroup <- rep(n.tgroup, length.out = length(.$tgroup))
      if (is.null(n.tgroup))
        n.tgroup <- 0
      if (!is.null(.$lgroup)) {
        tgroup <- c("", tgroup)
        n.tgroup <- c(1, n.tgroup)
      }
      if (!is.null(.$rgroup)) {
        tgroup <- c(tgroup, "")
        n.tgroup <- c(n.tgroup, 1)
      }
      if (sum(n.tgroup) != ncol(charac.x)) {
        n.tgroup[length(n.tgroup)] <- n.tgroup[length(n.tgroup)] + ncol(charac.x) - sum(n.tgroup) + !is.null(.$lgroup) + !is.null(.$rgroup)
      }
      cat(paste(cells.textile(span = paste("|\\", n.tgroup, sep = ""), align = .$talign, valign = .$tvalign, style = .$tstyle), tgroup, sep = ". "), "|\n")
    }
    
    cat(rows, sep = "\n")

    if (!is.null(.$bgroup)) {
      bgroup <- .$bgroup
      n.bgroup <- .$n.bgroup
      if (is.null(n.bgroup))
        bgroup <- bgroup[1]
      n.bgroup <- rep(n.bgroup, length.out = length(.$bgroup))
      if (is.null(n.bgroup))
        n.bgroup <- 0
      if (!is.null(.$lgroup)) {
        bgroup <- c("", bgroup)
        n.bgroup <- c(1, n.bgroup)
      }
      if (!is.null(.$rgroup)) {
        bgroup <- c(bgroup, "")
        n.bgroup <- c(n.bgroup, 1)
      }
      if (sum(n.bgroup) != ncol(charac.x)) {
        n.bgroup[length(n.bgroup)] <- n.bgroup[length(n.bgroup)] + ncol(charac.x) - sum(n.bgroup) + !is.null(.$lgroup) + !is.null(.$rgroup)
      }
      cat(paste(cells.textile(span = paste("|\\", n.bgroup, sep = ""), align = .$balign, valign = .$bvalign, style = .$bstyle), bgroup, sep = ". "), "|\n")
    }
  }
})

asciiList <- proto(expr = {
  new <- function(.,
    x,
    caption, 
    caption.level, 
    list.type) proto(.,
    x = x,
    caption = caption, 
    caption.level = caption.level, 
    list.type = list.type)

  show.asciidoc <- function(.) {
    if (.$list.type == "bullet") mark <- rep("\\*", length(.$x))
    if (.$list.type == "number") mark <- rep("\\.", length(.$x))
    if (.$list.type == "none")   mark <- rep("", length(.$x))
    if (.$list.type == "label") {
      if (is.null(names(.$x))) {
        namesx <- paste("[[", 1:length(.$x), "]]", sep = "")
      } else {
        namesx <- names(.$x)
      }
      mark <- paste(namesx, "::\n  ", sep = "")
    }
    
    charac.x <- vector("character", length(.$x))
    for (i in 1:length(.$x)) {
      if (is.null(.$x[[i]])) next
      tmp <- .$x[[i]]
      if (.$list.type == "label") tmp <- sub("^\t*", "", tmp)
      tmp <- sub("(^.*)", paste(mark[i], "\\1", sep = ""), gsub('\t|(*COMMIT)(*FAIL)', mark[i], tmp, perl = TRUE))
      charac.x[i] <- sub(paste('(^', mark[i], '+)(.*)', sep = ""), '\\1 \\2', tmp)
    }
    cat(header.asciidoc(caption = .$caption, caption.level = .$caption.level))
    cat(charac.x, sep = "\n")
  }

  show.rest <- function(.) {
    if (.$list.type == "bullet") mark <- rep("*", length(.$x))
    if (.$list.type == "number") mark <- rep("#.", length(.$x))
    if (.$list.type == "none")  mark <- rep("", length(.$x))
    if (.$list.type == "label") {
      if (is.null(names(.$x))) {
        namesx <- paste("[[", 1:length(.$x), "]]", sep = "")
      } else {
        namesx <- names(.$x)
      }
      mark <- paste(namesx, "\n ", sep = "")
    }
    y <- gsub("(^\t*)(.*)", "\\1", .$x)
    z <- NULL
    for (i in 2:length(y))
      z <- c(z, ifelse(y[i] != y[i-1], i-1, NA))

    cat(header.rest(caption = .$caption, caption.level = .$caption.level), sep = "\n")

    for (i in 1:length(.$x)) {
      tmp <- .$x[[i]]
      if (.$list.type == "label") tmp <- sub("^\t*", "", tmp)
      tmp <- gsub('\t|(*COMMIT)(*FAIL)', "  ", tmp, perl = TRUE)
      tmp <- sub("(^ *)", paste("\\1", mark[i], " ", sep = ""), tmp)
      cat(tmp, "\n")
      if (i %in% z)
        cat("\n")
    }
  }

  show.org <- function(.) {
    indent.mark <- "  "
    if (.$list.type == "bullet") mark <- rep("-", length(.$x))
    if (.$list.type == "number") mark <- paste(seq(1, length(.$x), 1), ".", sep = "")
    if (.$list.type == "none")  { mark <- rep("", length(.$x)); indent.mark = ""}
    if (.$list.type == "label") {
      if (is.null(names(.$x))) {
        namesx <- paste("[ [ ", 1:length(.$x), " ] ]", sep = "")
      } else {
        namesx <- names(.$x)
      }
      mark <- paste("- ", namesx, " ::", sep = "")
      indent.mark = "  "
    }
    
    charac.x <- vector("character", length(.$x))
    for (i in 1:length(.$x)) {
      tmp <- .$x[[i]]
      tmp <- gsub('\t|(*COMMIT)(*FAIL)', indent.mark, tmp, perl = TRUE)
      charac.x[i] <- sub("(^ *)", paste("\\1", mark[i], " ", sep = ""), tmp)
    }
    cat(header.org(caption = .$caption, caption.level = .$caption.level))
    cat(charac.x, sep = "\n")
  }

  show.t2t <- function(.) {
    indent.mark <- " "
    if (.$list.type == "bullet") mark <- rep("-", length(.$x))
    if (.$list.type == "number") mark <- rep("+", length(.$x))
    if (.$list.type == "none")  { mark <- rep("", length(.$x)); indent.mark = "" }
    if (.$list.type == "label") {
      if (is.null(names(.$x))) {
        namesx <- paste("[[", 1:length(.$x), "]]", sep = "")
      } else {
        namesx <- names(.$x)
      }
      mark <- paste(": ", namesx, "\n", sep = "")
      indent.mark = ""
    }
    
    charac.x <- vector("character", length(.$x))
    for (i in 1:length(.$x)) {
      tmp <- .$x[[i]]
      if (.$list.type == "label") tmp <- sub("^\t*", "", tmp)
      tmp <- gsub('\t|(*COMMIT)(*FAIL)', indent.mark, tmp, perl = TRUE)
      charac.x[i] <- sub("(^ *)", paste("\\1", mark[i], indent.mark, sep = ""), tmp)
    }
    cat(header.t2t(caption = .$caption, caption.level = .$caption.level))
    cat(charac.x, sep = "\n")
  }

  show.textile <- function(.) {
    if (.$list.type == "bullet") mark <- rep("*", length(.$x))
    if (.$list.type == "number") mark <- rep("#", length(.$x))
    if (.$list.type == "none")   mark <- rep("", length(.$x))
    if (.$list.type == "label") {
      if (is.null(names(.$x))) {
        namesx <- paste("[[ ", 1:length(.$x), " ]]", sep = "")
      } else {
        namesx <- names(.$x)
      }
      mark <- paste("- ", namesx, " := ", sep = "")
    }
    
    charac.x <- vector("character", length(.$x))
    for (i in 1:length(.$x)) {
      if (is.null(.$x[[i]])) next
      tmp <- .$x[[i]]
      if (.$list.type == "label") tmp <- sub("^\t*", "", tmp)
      tmp <- sub("(^.*)", paste(mark[i], "\\1", sep = ""), gsub('\t|(*COMMIT)(*FAIL)', mark[i], tmp, perl = TRUE))
      charac.x[i] <- sub(paste('(^\\', mark[i], '+)(.*)', sep = ""), '\\1 \\2', tmp)
    }
    cat(header.asciidoc(caption = .$caption, caption.level = .$caption.level))
    cat(charac.x, sep = "\n")
  }
})

asciiMixed <- proto(expr = {
  new <- function(.,
    ...) {
    args <- list(...)
    noms <- as.character(as.list(substitute(list(...)))[-1])
    if (is.null(noms)) noms <- paste("obj", 1:length(args), sep = "")
    names(args) <- noms 
    as.proto(args)
  }

  show.asciidoc <- function(.) {
    args <- rev(as.list(.))
    for (i in seq_along(args)) {
      if (is.null(args[[i]])) next
      print(args[[i]], type = "asciidoc") 
      if (i != length(args)) cat("\n") 
    }
  }
  
  show.rest <- function(.) {
    args <- rev(as.list(.))
    for (i in seq_along(args)) {
      if (is.null(args[[i]])) next
      print(args[[i]], type = "rest") 
      if (i != length(args)) cat("\n") 
    }
  }

  show.org <- function(.) {
    args <- rev(as.list(.))
    for (i in seq_along(args)) {
      if (is.null(args[[i]])) next
      print(args[[i]], type = "org") 
      if (i != length(args)) cat("\n") 
    }
  }

  show.t2t <- function(.) {
    args <- rev(as.list(.))
    for (i in seq_along(args)) {
      if (is.null(args[[i]])) next
      print(args[[i]], type = "t2t")
      if (i != length(args)) cat("\n") 
    }
  }
  show.textile <- function(.) {
    args <- rev(as.list(.))
    for (i in seq_along(args)) {
      if (is.null(args[[i]])) next
      print(args[[i]], type = "textile")
      if (i != length(args)) cat("\n") 
    }
  }
})

