initial commit

.gitignore

@@ -0,0 +1 @@
+*~

README.markdown

@@ -0,0 +1,9 @@
+rorg --- R and org-mode
+======================
+
+* for information on R see the [R website](http://www.r-project.org/)
+* for information on org see the [Org-Mode website](http://org-mode.org)
+
+Probably would be good to place the main objectives here, once they
+are ironed out.
+

existing_tools/RweaveOrg/RweaveOrg.R

@@ -0,0 +1,358 @@
+require(utils)
+
+RweaveOrg = function () {
+  list(setup = RweaveOrgSetup, runcode = RweaveOrgRuncode, 
+       writedoc = RweaveOrgWritedoc, finish = RweaveOrgFinish, 
+       checkopts = RweaveOrgOptions)
+}
+
+RweaveOrgSetup <-
+  function (file, syntax, output = NULL, quiet = FALSE, debug = FALSE, 
+            echo = TRUE, eval = TRUE, keep.source = FALSE, split = FALSE, 
+            stylepath, pdf = TRUE, eps = TRUE) {
+    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+")
+    if (missing(stylepath)) {
+      p <- as.vector(Sys.getenv("SWEAVE_STYLEPATH_DEFAULT"))
+      stylepath <- if (length(p) >= 1 && nzchar(p[1])) 
+        identical(p, "TRUE")
+      else TRUE
+    }
+    if (stylepath) {
+      styfile <- file.path(R.home("share"), "texmf", "Sweave")
+      if (.Platform$OS.type == "windows") 
+        styfile <- gsub("\\\\", "/", styfile)
+      if (length(grep(" ", styfile))) 
+        warning(gettextf("path to '%s' contains spaces,\n", 
+                         styfile), gettext("this may cause problems when running LaTeX"), 
+                domain = NA)
+    }
+    else styfile <- "Sweave"
+    options <- list(prefix = TRUE, prefix.string = prefix.string, 
+                    engine = "R", print = FALSE, eval = eval, fig = FALSE, 
+                    pdf = pdf, eps = eps, width = 6, height = 6, term = TRUE, 
+                    echo = echo, keep.source = keep.source, results = "verbatim", 
+                    split = split, strip.white = "true", include = TRUE, 
+                    pdf.version = "1.1", pdf.encoding = "default", concordance = FALSE, 
+                    expand = TRUE)
+    options <- RweaveOrgOptions(options)
+    list(output = output, styfile = styfile, havesty = FALSE, 
+         haveconcordance = FALSE, debug = debug, quiet = quiet, 
+         syntax = syntax, options = options, chunkout = list(), 
+         srclines = integer(0), srcfile = srcfile(file))
+  }
+
+makeRweaveOrgCodeRunner <- 
+  function (evalFunc = RweaveEvalWithOpt) 
+{
+  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$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) {
+      chunkout <- object$chunkout[chunkprefix][[1]]
+      if (is.null(chunkout)) {
+        chunkout <- file(paste(chunkprefix, "tex", 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) == 0) 
+      return(object)
+    srclines <- attr(chunk, "srclines")
+    linesout <- integer(0)
+    srcline <- srclines[1]
+    srcrefs <- attr(chunkexps, "srcref")
+    if (options$expand) 
+      lastshown <- 0
+    else lastshown <- srcline - 1
+    thisline <- 0
+    for (nce in 1:length(chunkexps)) {
+      ce <- chunkexps[[nce]]
+      if (nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) {
+        if (options$expand) {
+          srcfile <- attr(srcref, "srcfile")
+          showfrom <- srcref[1]
+          showto <- srcref[3]
+        }
+        else {
+          srcfile <- object$srcfile
+          showfrom <- srclines[srcref[1]]
+          showto <- srclines[srcref[3]]
+        }
+        dce <- getSrcLines(srcfile, lastshown + 1, showto)
+        leading <- showfrom - lastshown
+        lastshown <- showto
+        srcline <- srclines[srcref[3]]
+        while (length(dce) && length(grep("^[[:blank:]]*$", 
+                                          dce[1]))) {
+          dce <- dce[-1]
+          leading <- leading - 1
+        }
+      }
+      else {
+        dce <- deparse(ce, width.cutoff = 0.75 * getOption("width"))
+        leading <- 1
+      }
+      if (object$debug) 
+        cat("\nRnw> ", paste(dce, collapse = "\n+  "), 
+            "\n")
+      if (options$echo && length(dce)) {
+        if (!openSinput) {
+          if (!openSchunk) {
+            cat("#+BEGIN_LaTeX\n", file = chunkout, append = TRUE)
+            cat("\\begin{Schunk}\n", file = chunkout, append = TRUE)
+            linesout[thisline + 1:2] <- srcline
+            thisline <- thisline + 2
+            openSchunk <- TRUE
+          }
+          cat("\\begin{Sinput}", file = chunkout, append = TRUE)
+          openSinput <- TRUE
+        }
+        cat("\n", paste(getOption("prompt"), dce[1:leading], 
+                        sep = "", collapse = "\n"), file = chunkout, 
+            append = TRUE, sep = "")
+        if (length(dce) > leading) 
+          cat("\n", paste(getOption("continue"), dce[-(1:leading)], 
+                          sep = "", collapse = "\n"), file = chunkout, 
+              append = TRUE, sep = "")
+        linesout[thisline + 1:length(dce)] <- srcline
+        thisline <- thisline + length(dce)
+      }
+      tmpcon <- file()
+      sink(file = tmpcon)
+      err <- NULL
+      if (options$eval) 
+        err <- evalFunc(ce, options)
+      cat("\n")
+      sink()
+      output <- readLines(tmpcon)
+      close(tmpcon)
+      if (length(output) == 1 & output[1] == "") 
+        output <- NULL
+      RweaveTryStop(err, options)
+      if (object$debug) 
+        cat(paste(output, collapse = "\n"))
+      if (length(output) > 0 & (options$results != "hide")) {
+        if (openSinput) {
+          cat("\n\\end{Sinput}\n", file = chunkout, append = TRUE)
+          linesout[thisline + 1:2] <- srcline
+          thisline <- thisline + 2
+          openSinput <- FALSE
+        }
+        if (options$results == "verbatim") {
+          if (!openSchunk) {
+            cat("#+BEGIN_LaTeX\n", file = chunkout, append = TRUE)
+            cat("\\begin{Schunk}\n", file = chunkout, 
+                append = TRUE)
+            linesout[thisline + 1:2] <- srcline
+            thisline <- thisline + 2
+            openSchunk <- TRUE
+          }
+          cat("\\begin{Soutput}\n", file = chunkout, 
+              append = TRUE)
+          linesout[thisline + 1] <- srcline
+          thisline <- thisline + 1
+        }
+        output <- paste(output, collapse = "\n")
+        if (options$strip.white %in% c("all", "true")) {
+          output <- sub("^[[:space:]]*\n", "", output)
+          output <- sub("\n[[:space:]]*$", "", output)
+          if (options$strip.white == "all") 
+            output <- sub("\n[[:space:]]*\n", "\n", output)
+        }
+        cat(output, file = chunkout, append = TRUE)
+        count <- sum(strsplit(output, NULL)[[1]] == "\n")
+        if (count > 0) {
+          linesout[thisline + 1:count] <- srcline
+          thisline <- thisline + count
+        }
+        remove(output)
+        if (options$results == "verbatim") {
+          cat("\n\\end{Soutput}\n", file = chunkout, 
+              append = TRUE)
+          linesout[thisline + 1:2] <- srcline
+          thisline <- thisline + 2
+        }
+      }
+    }
+    if (openSinput) {
+      cat("\n\\end{Sinput}\n", file = chunkout, append = TRUE)
+      linesout[thisline + 1:2] <- srcline
+      thisline <- thisline + 2
+    }
+    if (openSchunk) {
+      cat("\\end{Schunk}\n", file = chunkout, append = TRUE)
+      cat("#+END_LaTeX\n", file = chunkout, append = TRUE)
+      linesout[thisline + 1:2] <- srcline
+      thisline <- thisline + 2
+    }
+    if (is.null(options$label) & options$split) 
+      close(chunkout)
+    if (options$split & options$include) {
+      cat("#+LaTeX:  \\input{", chunkprefix, "}\n", sep = "", file = object$output, 
+          append = TRUE)
+      linesout[thisline + 1] <- srcline
+      thisline <- thisline + 1
+    }
+    if (options$fig && options$eval) {
+      if (options$eps) {
+        grDevices::postscript(file = paste(chunkprefix, 
+                                "eps", sep = "."), width = options$width, height = options$height, 
+                              paper = "special", horizontal = FALSE)
+        err <- try({
+          SweaveHooks(options, run = TRUE)
+          eval(chunkexps, envir = .GlobalEnv)
+        })
+        grDevices::dev.off()
+        if (inherits(err, "try-error")) 
+          stop(err)
+      }
+      if (options$pdf) {
+        grDevices::pdf(file = paste(chunkprefix, "pdf", 
+                         sep = "."), width = options$width, height = options$height, 
+                       version = options$pdf.version, encoding = options$pdf.encoding)
+        err <- try({
+          SweaveHooks(options, run = TRUE)
+          eval(chunkexps, envir = .GlobalEnv)
+        })
+        grDevices::dev.off()
+        if (inherits(err, "try-error")) 
+          stop(err)
+      }
+      if (options$include) {
+        chunksuffix <- ifelse(options$eps, "eps", "pdf")
+        cat("[[./", paste(chunkprefix, chunksuffix, sep = "."), "]]\n", 
+            sep = "", file = object$output, append = TRUE)
+        linesout[thisline + 1] <- srcline
+        thisline <- thisline + 1
+      }
+    }
+    object$linesout <- c(object$linesout, linesout)
+    return(object)
+  }
+  RweaveOrgRuncode
+}
+
+RweaveOrgRuncode <- makeRweaveOrgCodeRunner()
+
+RweaveOrgWritedoc <-
+  function (object, chunk) {
+    linesout <- attr(chunk, "srclines")
+    ## This part of the function adds the appropriate \usepackage
+    ## directive and begins the document.  Skip this for now, but
+    ## eventually add in detection for #+LATEX_PREAMBLE
+###     if (length(grep("\\usepackage[^\\}]*Sweave.*\\}", chunk))) 
+###       object$havesty <- TRUE
+###     if (!object$havesty) {
+###       begindoc <- "^[[:space:]]*\\\\begin\\{document\\}"
+###       which <- grep(begindoc, chunk)
+###       if (length(which)) {
+###         chunk[which] <- sub(begindoc, paste("\\\\usepackage{", 
+###                                             object$styfile, "}\n\\\\begin{document}", sep = ""), 
+###                             chunk[which])
+###         linesout <- linesout[c(1:which, which, seq(from = which + 
+###                                                    1, length.out = length(linesout) - which))]
+###         object$havesty <- TRUE
+###       }
+###     }
+    while (length(pos <- grep(object$syntax$docexpr, chunk))) {
+      cmdloc <- regexpr(object$syntax$docexpr, chunk[pos[1]])
+      cmd <- substr(chunk[pos[1]], cmdloc, cmdloc + attr(cmdloc, 
+                                                         "match.length") - 1)
+      cmd <- sub(object$syntax$docexpr, "\\1", cmd)
+      if (object$options$eval) {
+        val <- as.character(eval(parse(text = cmd), envir = .GlobalEnv))
+        if (length(val) == 0) 
+          val <- ""
+      }
+      else val <- paste("\\\\verb{<<", cmd, ">>{", sep = "")
+      chunk[pos[1]] <- sub(object$syntax$docexpr, val, chunk[pos[1]])
+    }
+    while (length(pos <- grep(object$syntax$docopt, chunk))) {
+      opts <- sub(paste(".*", object$syntax$docopt, ".*", sep = ""), 
+                  "\\1", chunk[pos[1]])
+      object$options <- SweaveParseOptions(opts, object$options, 
+                                           RweaveOrgOptions)
+      if (isTRUE(object$options$concordance) && !object$haveconcordance) {
+        savelabel <- object$options$label
+        object$options$label <- "concordance"
+        prefix <- RweaveChunkPrefix(object$options)
+        object$options$label <- savelabel
+        object$concordfile <- paste(prefix, "org", sep = ".")
+        chunk[pos[1]] <- sub(object$syntax$docopt, paste("\\\\input{", 
+                                                         prefix, "}", sep = ""), chunk[pos[1]])
+        object$haveconcordance <- TRUE
+      }
+      else chunk[pos[1]] <- sub(object$syntax$docopt, "", chunk[pos[1]])
+    }
+    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 run org-export-as-latex on '%s'", outputname), 
+          "\n", sep = "")
+    close(object$output)
+    if (length(object$chunkout) > 0) 
+      for (con in object$chunkout) close(con)
+    if (object$haveconcordance) {
+      linesout <- object$linesout
+      vals <- rle(diff(linesout))
+      vals <- c(linesout[1], as.numeric(rbind(vals$lengths, 
+                                              vals$values)))
+      concordance <- paste(strwrap(paste(vals, collapse = " ")), 
+                           collapse = " %\n")
+      special <- paste("\\special{concordance:", outputname, 
+                       ":", inputname, ":%\n", concordance, "}\n", sep = "")
+      cat(special, file = object$concordfile)
+    }
+    invisible(outputname)
+  }  
+
+RweaveOrgOptions <- RweaveLatexOptions

existing_tools/RweaveOrg/SweaveSyntaxOrg.R

@@ -0,0 +1,19 @@
+SweaveSyntaxOrg <- list()
+SweaveSyntaxOrg$doc <- "^#\\+END_[SR]"
+SweaveSyntaxOrg$code <- "^#\\+BEGIN_[SR]:?[[:space:]]*(.*)$"
+SweaveSyntaxOrg$coderef <- "^#\\+[SR]_CODEREF:?[[:space:]]*(.*)$"
+SweaveSyntaxOrg$docopt <- "^#\\+[SR]_OPTS:?[[:space:]]*(.*)$"
+SweaveSyntaxOrg$docexpr <- "\\\\[SR]\\{([^\\}]*)\\}"
+SweaveSyntaxOrg$extension <- "\\.[SRsr]org$"
+SweaveSyntaxOrg$syntaxname <- "^#\\+[SR]WEAVE_SYNTAX:?[[:space:]]*(.*)$"
+SweaveSyntaxOrg$input <- "^#\\+[SR]_FILE:?[[:space:]]*(.*)$"
+SweaveSyntaxOrg$trans <- list()
+SweaveSyntaxOrg$trans$doc <- "\\\\end{Scode}"
+SweaveSyntaxOrg$trans$code <- "\\\\begin{Scode}{\\1}"
+SweaveSyntaxOrg$trans$coderef <- "\\\\Scoderef{\\1}"
+SweaveSyntaxOrg$trans$docopt <- "\\\\SweaveOpts{\\1}"
+SweaveSyntaxOrg$trans$docexpr <- "\\\\Sexpr{\\1}"
+SweaveSyntaxOrg$trans$extension <- ".[SR]org"
+SweaveSyntaxOrg$trans$syntaxname <- "\\\\SweaveSyntax{SweaveSyntaxLatex}"
+SweaveSyntaxOrg$trans$input <- "\\\\SweaveInput{\\1}"
+attr(SweaveSyntaxOrg, "class") <- "SweaveSyntax"

existing_tools/RweaveOrg/export_testing.R

@@ -0,0 +1,5 @@
+source("SweaveSyntaxOrg.R")
+source("RweaveOrg.R")
+
+Sweave("testing.Rorg", driver=RweaveOrg, syntax=SweaveSyntaxOrg)
+Stangle("testing.Rorg", driver=Rtangle(), syntax=SweaveSyntaxOrg)

existing_tools/RweaveOrg/testing.Rorg

@@ -0,0 +1,73 @@
+# -*- mode: org -*-
+#+OPTIONS:  LaTeX:t
+
+* Sweave and org-mode
+  If you're reading a PDF version of this document, you should also
+  look at [[file:testing.Rorg][testing.Rorg]] (the source file) and [[file:testing.org][testing.org]] (the output
+  of the Sweave process).
+
+  Keep in mind that one of the advantages of a block-based approach is
+  using \texttt{C-'} to edit code in its native mode.
+
+** Use the Sweave package for latex formatting
+   Org allows us to issue commands to be included in \{LaTeX} export.
+#+LATEX_HEADER:  \usepackage{Sweave}
+
+** R blocks
+   The first argument to an R block when using Sweave is the label for
+   that block.
+
+   Not all R blocks are printed.  Sweave options allow the printing of
+   the evaluated code, the output of the code, both, or neither.
+
+*** R code that is not printed
+#+BEGIN_R:  hidden_block, echo=FALSE, results=HIDE
+   a <- 3
+   b <- 6
+#+END_R
+
+*** R code that is printed
+#+BEGIN_R:  visible_block
+   c <- 4
+#+END_R
+   
+   We can use block labels to embed blocks by reference (even if they
+   weren't printed before).
+*** R code that references other blocks
+#+BEGIN_R:  combined_block
+#+R_CODEREF:  hidden_block
+#+R_CODEREF:  visible_block
+   a + b +c
+#+END_R
+
+** Inline references to R data
+   We can evaluate R code inline.
+*** Used in text
+    The value of =a= is \R{a}.
+
+*** Used in a table
+    | a     | b     | c     | TOTAL         |
+    |-------+-------+-------+---------------|
+    | \R{a} | \R{b} | \R{c} | \R{a + b + c} |
+
+** Single-line R commands
+   If we want a line of R code to be evaluated but not printed,
+   there's a convenient shorthand.  This only works for single lines
+   of R code, but you can have more than one in a row.
+#+R:  library(lattice)
+#+R:  data(cars)
+
+** Graphics
+   We use values defined elsewhere in the buffer to produce this
+   graph.  The new CAPTION and LABEL arguments work just fine.
+
+#+CAPTION:  speed by distance
+#+LABEL:  fig:speed_by_distance
+#+BEGIN_R fig=TRUE, eps=FALSE, pdf=TRUE
+print(xyplot(speed ~ dist, cars,
+       panel = function (x, y, ...) {
+         panel.xyplot(x, y, ...)
+         panel.abline(h=a)
+         panel.abline(v=b)
+       }))
+#+END_R

existing_tools/org-R.el

@@ -0,0 +1,846 @@
+;;; org-R.el --- Numerical computation and data visualisation for org-mode using R
+
+;; Copyright (C) 2009
+;;   Free Software Foundation, Inc.
+
+;; Author: Dan Davison <davison@stats.ox.ac.uk>
+;; Keywords: org, R, ESS, tables, graphics
+;; Homepage: http://www.stats.ox.ac.uk/~davison/software/org-R
+;; Version: 0.05 2009-02-05
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file allows R (http://www.r-project.org) code to be applied to
+;; emacs org-mode (http://orgmode.org) tables. When the
+;; result of the analysis is a vector or matrix, it is output back
+;; into the org-mode buffer as a new org table. Alternatively the R
+;; code may be used to plot the data in the org table. It requires R to be
+;; running in an inferior-ess-mode buffer (install Emacs Speaks
+;; Statistics http://ess.r-project.org and issue M-x R). 
+;; 
+;;
+;; The user interface is via two different options lines in the org
+;; buffer. As is conventional in org-mode, these are lines starting
+;; with `#+'. Lines starting with #+R: specify options in the
+;; standard org style (option:value) and are used to specify certain
+;; off-the-shelf transformations and plots of the table data. The
+;; #+R: line is also used to specify the data to be analysed
+;; (either an org table or a csv file), and to restrict the analysis
+;; to certain columns etc. In lines starting #+RR: you can supply
+;; literal R code, giving you full control over what you do with the
+;; table. With point in the first #+R line, M-x org-R-apply
+;; makes happen whatever has been specified in those lines. 
+
+;; The best documentation is currently the Worg tutorial:
+;;
+;; http://orgmode.org/worg/org-tutorials/org-R/org-R.php
+
+
+(defconst org-R-skeleton-funcall-1-arg
+  "%s(x[%s]%s)"
+  "Skeleton of a call to an R function.
+E.g. barplot(x[,3:5], names.arg=rownames(x))")
+
+(defconst org-R-skeleton-funcall-2-args
+  "%s(x[,%s], x[,%s]%s)"
+  "Skeleton of a call to an R function which can take x and y
+  args.")
+
+(defconst org-R-write-org-table-def
+  "write.org.table <- function (x, write.rownames = TRUE) 
+{
+    if(!is.null(dim(x)) && length(dim(x)) > 2)
+        stop(\"Object must be 1- or 2-dimensional\") ;
+    if(is.vector(x) || is.table(x) || is.factor(x) || is.array(x)) 
+        x <- as.matrix(x) ;
+    if(!(is.matrix(x) || inherits(x, c('matrix', 'data.frame')))) {
+       invisible() ;
+       print(x) ;
+       stop(\"Object not recognised as 1- or 2-dimensional\") ;
+    } ;
+    if(is.null(colnames(x))) 
+        colnames(x) <- rep('', ncol(x)) ;
+    if(write.rownames) 
+        x <- cbind(rownames(x), x) ;
+    cat('|', paste(colnames(x), collapse = ' | '), '|\\n') ;
+    cat('|', paste(rep('----', ncol(x)), collapse = '+'), '|\\n', sep = '') ;
+    invisible(apply(x, 1, function(row) cat('|', paste(row, collapse = ' | '), '|\\n'))) ;
+}"
+  "Definition of R function to write org table representation of R objects.
+To see a more human-readable version of this, look at the code,
+or type dput(write.org.table) RET at the R (inferior-ess-mode
+buffer) prompt.")
+
+
+(defun org-R-apply ()
+  "Construct and evaluate an R function call.
+Construct an R function corresponding to the #+R: and #+RR:
+lines. R must be currently running in an inferior-ess-mode
+buffer. The function evaluates any user-supplied R code in the
+#+RR: line before the off-the-shelf actions specified in the #+R:
+line. The user-supplied R code can operate on a variable called x
+that is the org table represented as a data frame in R. Text
+output from the R process may be inserted into the org buffer, as
+an org table where appropriate."
+  (interactive)
+  (require 'ess)
+  (save-excursion 
+    (beginning-of-line)
+    (unless (looking-at "#\\+RR?:") (error "Point must be in a #+R or #+RR line"))
+    (while (looking-at "#\\+RR?:") (forward-line -1))
+    (forward-line)
+    ;; For the rest of the code in this file we are based at the
+    ;; beginning of the first #+R line
+
+    ;; FIXME: if point is at the beginning of the #+RR? lines when
+    ;; this function is called, then tabular output gets inserted,
+    ;; leaving point up at the top of the tabular output.
+
+    (let* ((options (org-R-get-options))
+	   (code (org-R-construct-code options))
+	   (infile (plist-get options :infile))
+	   (ext (if infile (file-name-extension infile)))
+	   csv-file)
+
+      (if (string-equal ext "csv")
+	  (setq csv-file infile)
+	(setq csv-file
+	      (org-R-export-to-csv
+	       (make-temp-file "org-R-tmp" nil ".csv") options)))
+      
+      (org-R-eval code csv-file options)
+
+      (delete-other-windows) ;; FIXME
+      (if (plist-get options :showcode) (org-R-showcode code)))))
+
+(defun org-R-apply-to-subtree ()
+  "Call org-R-apply in every org-R block in current subtree."
+  ;; This currently relies on re-search-forward leaving point after
+  ;; the #+RR?: If point were at the beginning of the line, then
+  ;; tabular input would get inserted leaving point above the #+RR?:,
+  ;; and this would loop infinitely. Same for org-R-apply-to-buffer.
+  (interactive)
+  (save-excursion
+    (org-back-to-heading)
+    (while (re-search-forward 
+	    "^#\\+RR?:"
+	    (save-excursion (org-end-of-subtree)) t)
+      (org-R-apply)
+      (forward-line)
+      (while (looking-at "#\\+RR?")
+	(forward-line)))))
+
+(defun org-R-apply-to-buffer ()
+  "Call org-R-apply in every org-R block in the buffer."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward "^#\\+RR?:" nil t)
+      (org-R-apply)
+      (forward-line)
+      (while (looking-at "#\\+RR?")
+	(forward-line)))))
+  
+(defun org-R-construct-code (options)
+  "Construct the R function that implements the requested
+behaviour. The body of this function derives from two sources:
+
+1. Explicit R code which is read from lines starting with
+#+RR: by org-R-get-user-code, and
+
+2. Off-the-shelf code corresponding to options specified in the
+#+R: line. This code is constructed by
+org-R-off-the-shelf-code."
+  (let ((user-code (org-R-get-user-code))
+	(action (plist-get options :action)))
+
+    (if (or (eq action 'tabulate) (eq action 'transpose))
+	(setq options (plist-put options :output-to-buffer t)))
+    (format "function(x){%sx}"
+	    (concat
+	     (when user-code (concat user-code ";"))
+	     (when action (concat (org-R-off-the-shelf-code options) ";"))))))
+
+(defun org-R-get-user-code (&optional R)
+  "Read user-supplied R code from #+RR: lines"
+  (let ((case-fold-search t))
+    (save-excursion
+      (while (looking-at "^#\\+\\(RR?:\\) *\\(.*\\)")
+	(if (string= "RR:" (match-string 1))
+	    (setq R (concat R (when R ";") (match-string 2))))
+	(forward-line))))
+  R)
+
+(defun org-R-off-the-shelf-code (options)
+  "Return R code implementing the actions requested in the
+#+R: lines."
+  
+  ;; This is a somewhat long function as it deals with several
+  ;; different cases, corresponding to all the off-the-shelf actions
+  ;; that have been implemented.
+  
+  (let* ((action (plist-get options :action))
+	 (cols (plist-get options :columns))
+	 (ncols (org-R-number-of-columns cols))
+	 (nxcols (nth 0 ncols))
+	 (nycols (nth 1 ncols))
+	 (cols-R (org-R-make-index-vectors cols))
+	 (xcols-R (nth 0 cols-R))
+	 (ycols-R (nth 1 cols-R))
+	 seq args largs extra-code title colour matrix-index)
+    
+    ;; I want this to affect options outside this function.  Will it
+    ;; necessarily do so? (not if plist-put adds to head of the
+    ;; plist?)
+    (setq options (plist-put options :nxcols nxcols))
+    
+    (cond ((eq action 'points)
+	   (setq action 'plot)
+	   (setq options (plist-put options :lines nil)))
+	  ((eq action 'lines)
+	   (setq action 'plot)
+	   (setq options (plist-put options :lines t))))
+    
+    (if (and (setq title (plist-get options :title)) (symbolp title))
+	(setq title symbol-name title))
+    
+    (setq args (plist-put args :main (concat "\"" title "\"")))
+    
+    (if (setq colour (or (plist-get options :colour)
+			 (plist-get options :color)
+			 (plist-get options :col)))
+	(setq args
+	      (plist-put args :col
+			 (concat "\"" (if (symbolp colour) (symbol-name colour) colour) "\""))))
+      
+    (setq largs
+	  (if (setq legend (plist-get options :legend))
+	      (plist-put largs :x
+			 (concat "\"" (if (symbolp legend) (symbol-name legend) legend) "\""))
+	    (plist-put largs :x "\"topright\"")))
+
+    (cond
+     ((null ycols-R)
+      ;; single set of columns; implicit x values
+      (if (null xcols-R)
+	  (setq xcols-R "" matrix-index "")
+	(setq matrix-index (concat "," xcols-R)))
+      (cond
+
+       ;;----------------------------------------------------------------------
+
+       ((eq action 'barplot)
+	(if (eq nxcols 1)
+	    (progn
+	      (setq args (plist-put args :names.arg "rownames(x)"))
+	      (setq args (org-R-set-user-supplied-args args (plist-get options :args)))
+	      (format org-R-skeleton-funcall-1-arg
+		      "barplot" xcols-R
+		      (concat ", " (org-R-plist-to-R-args args))))
+	  
+	  (setq args (plist-put args :names.arg "colnames(x)"))
+	  (setq args (plist-put args :col "seq(nrow(x))"))
+	  (setq args (plist-put args :beside "TRUE"))
+
+	  (setq largs (plist-put largs :bty "\"n\""))
+	  ;; (setq largs (plist-put largs :lwd 10))
+	  (setq largs (plist-put largs :col "seq(nrow(x))"))
+	  (setq largs (plist-put largs :legend "rownames(x)"))
+	  
+	  (setq args (org-R-set-user-supplied-args args (plist-get options :args)))
+	  
+	  (concat (format org-R-skeleton-funcall-1-arg 
+			  "barplot(as.matrix" matrix-index
+			  (concat "), " (org-R-plist-to-R-args args)))
+		  "; legend(" (org-R-plist-to-R-args largs) ")")))
+
+       ;;----------------------------------------------------------------------
+
+       ((eq action 'density)
+	(if (and nxcols (> nxcols 1))
+	  (error "Multiple columns not implemented for action:%s" action))
+
+	(setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]")))
+	(setq args (org-R-set-user-supplied-args args (plist-get options :args)))
+
+	(format org-R-skeleton-funcall-1-arg
+		"plot(density" matrix-index
+		(concat "), " (org-R-plist-to-R-args args))))
+
+       ;;----------------------------------------------------------------------
+
+       ((eq action 'hist)
+	(if (and nxcols (> nxcols 1))
+	  (error "Multiple columns not implemented for action:%s" action))
+	(setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]")))
+	(setq args (org-R-set-user-supplied-args args (plist-get options :args)))
+	(setq args (concat ", " (org-R-plist-to-R-args args)))
+	(format org-R-skeleton-funcall-1-arg "hist" matrix-index args))
+       
+       ;;----------------------------------------------------------------------
+
+       ((eq action 'image)
+	(format org-R-skeleton-funcall-1-arg "image(as.matrix" matrix-index ")"))
+
+       ;;----------------------------------------------------------------------
+
+       ((eq action 'plot)
+	(setq seq (concat "seq_along("xcols-R")"))
+
+	(setq args (plist-put args :type (if (plist-get options :lines) "\"l\"" "\"p\"")))
+	(setq args (plist-put args :ylab (concat "colnames(x)["xcols-R"]")))
+	(setq args (concat ", " (org-R-plist-to-R-args args)))
+
+	(concat (format org-R-skeleton-funcall-1-arg
+			(if (eq nxcols 1) "plot" "matplot") matrix-index args)
+		extra-code))
+	
+       ;;----------------------------------------------------------------------
+
+       ((eq action 'tabulate)
+	(concat
+	 (if (plist-get options :sort)
+	     (format org-R-skeleton-funcall-1-arg
+		     "x <- sort(table" xcols-R "), decreasing=TRUE")
+	   (format org-R-skeleton-funcall-1-arg "x <- table" matrix-index ""))
+	 (if (eq nxcols 1) "; x <- data.frame(value=names(x), count=x[])")))
+       
+       ;;----------------------------------------------------------------------
+
+       ((eq action 'transpose)
+	(format org-R-skeleton-funcall-1-arg "x <- t" matrix-index ""))
+     
+       ;;----------------------------------------------------------------------
+       
+       ;; Don't recognise action: option, try applying it as the name of an R function.
+       
+       (t (format org-R-skeleton-funcall-1-arg
+		  (concat "x <- " (symbol-name action)) matrix-index ""))))
+     
+     ;;----------------------------------------------------------------------
+
+     (ycols-R
+      ;; x and y columns specified
+      (cond
+       
+       ;;----------------------------------------------------------------------
+       
+       ((eq action 'plot)
+	(unless (eq nxcols 1) (error "Multiple x-columns not implemented for action:plot"))
+	
+	(setq args
+	      (plist-put
+	       args :ylab
+	       (concat "if(length("ycols-R") == 1) colnames(x)["ycols-R"] else ''")))
+	(setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]")))
+
+	(setq args (plist-put args :type (if (plist-get options :lines) "\"l\"" "\"p\"")))
+	
+	(setq args (concat ", " (org-R-plist-to-R-args args)))
+	(setq seq (concat "seq_along("ycols-R")"))
+
+	(setq largs (plist-put largs :col seq))
+	(setq largs (plist-put largs :lty seq))
+	(setq largs (plist-put largs :bty "\"n\""))
+	(setq largs (plist-put largs :legend (concat "colnames(x)["ycols-R"]")))
+	
+	(setq extra-code
+	      (concat "; "
+		      "if(length("ycols-R") > 1) "
+		      "legend(" (org-R-plist-to-R-args largs) ")"))
+	
+	(concat (format org-R-skeleton-funcall-2-args
+			(if (and (eq nxcols 1) (eq nycols 1)) "plot" "matplot")
+			xcols-R ycols-R args)
+		extra-code))
+       
+       ;;----------------------------------------------------------------------
+       
+       (t (error "action:%s requires a single set of columns" (symbol-name action))))))))
+
+(defun org-R-set-user-supplied-args (args user-args)
+  "Set user-supplied values in arguments plist."
+  (while (setq prop (pop user-args))
+    (setq args (plist-put args prop (pop user-args))))
+  args)
+  
+(defun org-R-plist-to-R-args (plist)
+  "Convert a plist into a string of R arguments."
+  (let (arg-string arg)
+    (while (setq arg (pop plist))
+      (string-match ":\\(\.*\\)" (symbol-name arg))
+      (setq arg (match-string 1 (symbol-name arg)))
+      (setq arg-string
+	    (concat
+	     (if arg-string (concat arg-string ", "))
+	     (format "%s=%s" arg (pop plist)))))
+    arg-string))
+
+(defun org-R-alist-to-R-args (alist)
+  "Convert an alist of (argument . val) pairs into a string of R arguments.
+The alist is something like
+      '((arg1 . 1)
+	(arg2 . a)) 
+This isn't used, but it seems much nicer than
+my plist equivalent. Is there a better way to write the plist
+version?
+"
+  (mapconcat
+   'identity
+   (mapcar (lambda(pair) (format "%s = %s" (car pair) (cdr pair))) alist)
+   ", "))
+
+(defun org-R-make-index-vectors (cols)
+  "COLS is the lisp form given by the `columns:' option. It may
+take the following forms:
+
+1. integer atom        - the number of the column
+2. symbol/string atom  - the name of the column
+3. list of length 1    - same as 1 or 2 above
+4. list of length > 1  - specification of multiple columns as 1 or 2 above, unless it is
+5. list of 2 lists     - each list specifies (possibly multiple) columns
+
+In cases 1-4 this function returns a list of length 1, containing
+the R index vector as a string. In case 5 this function returns a
+list of two such index vectors.
+
+In cases 1 - 4, when a bivariate plot is requested such as by
+`action:lines', the x values are implicit, i.e
+1,2,...,number-of-rows.
+
+In case 4, an attempt is made to do something sensible with the
+multiple columns, e.g. for `action:lines' they will be plotted
+together on the same graph against the implicit x values, and for
+`action:barplot' the bars corresponding to a single row will be
+stacked on top of each other, or placed side by side, depending
+on the value of the `beside' option.
+
+For `action:tabulate', if 2 columns are selected, a
+two-dimensional table is created. If more than 2, then the
+appropriately dimensioned table is computed and inserted using
+the standard text representation of multi-dimensional arrays used
+by R (as org does not currently have tables of dimension > 2).
+
+The straightforward case of case 5 is that both lists are of
+length 1. For `action:plot' and `action:lines' these specify the
+y and x coordinates of the points to be plotted or joined by
+lines. 
+
+The intention is that `org-R-apply' does something
+corresponding to what would happen if you did the following in R:
+
+fun(x=tab[,xcols], y=tab[,ycols])
+
+where fun is the R function implementing the desired
+action (plotting/computation), tab is the org table, xcols are
+the columns specified in cases 1-4 above, and ycols are the
+second set of columns which might have been specified under case
+5 above. For relevant R documentation see the help page
+associated with the function xy.coords, e.g. by typing ?xy.coords
+at the R prompt.
+
+The following won't work with case 5: `tabulate'
+"
+  (defun org-R-make-index-vector (cols)
+    "Return the R indexing vector (as a string) corresponding to
+the lisp form COLS. In this function, COLS is a either a list of
+atoms, or an atom, i.e. in the form of cases 1-4"
+    (when cols
+      (let (to-stringf)
+	(unless (listp cols) (setq cols (list cols)))
+	(setq to-stringf 
+	      (cond ((car (mapcar 'symbolp cols))
+		     (lambda (symbol) (concat "\"" (symbol-name symbol) "\"")))
+		    ((car (mapcar 'integerp cols))
+		     'int-to-string)
+		    ((car (mapcar 'stringp cols))
+		     (lambda (string) (concat "\"" string "\"")))
+		    (t (error "Column selection should be symbol, integer or string: %S" cols))))
+	(concat (when (> (length cols) 1) "c(")
+		(mapconcat to-stringf cols ",")
+		(when (> (length cols) 1) ")")))))
+
+  (if (and (listp cols) (listp (car cols)))
+      (mapcar 'org-R-make-index-vector cols) ;; case 5
+    (list (org-R-make-index-vector cols))))  ;; other cases
+
+(defun org-R-number-of-columns (cols)
+  (defun f (c) (if (listp c) (length c) 1))
+  (if (and (listp cols) (listp (car cols)))
+      (mapcar 'f cols)
+    (list (f cols))))
+  
+(defun org-R-eval (R-function csv-file options)
+  "Apply an R function to tabular data and receive output as an org table.
+
+R-FUNCTION is a string; it may be simply the name of an
+appropriate R function (e.g. \"summary\", \"plot\"), or a
+user-defined anonymous function of the form
+\"(function(data.frame) {...})\". It will receive as its first
+argument the org table as an R 'data frame' -- a table-like
+structure which can have columns containing different types of
+data -- numeric, character etc.
+
+The R function may produce graphical and/or text output. If it
+produces text output, and the replace:t is specified, and if
+there is a table immediately above the #+R lines, then it is
+replaced by the text output. Otherwise the text output is
+inserted above the #+R lines.
+"
+  (let ((transit-buffer "org-R-transit")
+	(infile (plist-get options :infile))
+	(output-file (plist-get options :outfile))
+	(title (plist-get options :title))
+	output-format graphics-output-file width height)
+    
+    (unless (not output-file)
+      ;; We are writing output to file. Determine file format and
+      ;; location, and open graphics device if necessary.
+      (if (string-match
+	   "\\(.*\.\\)?\\(org\\|png\\|jpg\\|jpeg\\|pdf\\|ps\\|bmp\\|tiff\\)$"
+	   output-file)
+	  (setq output-format (match-string 2 output-file))
+	(error "Did not recognise file name suffix %s as available output format"
+	       (match-string 2 output-file)))
+      (unless (match-string 1 output-file)
+	;; only suffix provided: store in org-attach dir
+	(require 'org-attach)
+	(let ((temporary-file-directory (org-attach-dir t)))
+	  (setq output-file
+		(make-temp-file
+		 "org-R-output-" nil (concat "." output-format)))))
+      (if (eq output-format "jpg") (setq output-format "jpeg"))
+      (setq graphics-output-file (not (string-equal output-format "org")))
+      (if graphics-output-file ;; open the graphics device
+	  (ess-execute
+	   (concat output-format "(file=\"" output-file "\""
+		   (if (setq width (plist-get options :width))
+		       (format ", width=%d" width))
+		   (if (setq height (plist-get options :height))
+		       (format ", height=%d" height)) ")"))))
+    
+    ;; Apply R code to table (which is now stored as a csv file)
+    ;; does it matter whether this uses ess-command or ess-execute?
+    
+    ;; First evaluate function definition for R -> org table conversion
+    (ess-execute (replace-regexp-in-string "\n" " " org-R-write-org-table-def)
+		 nil transit-buffer)
+
+    ;; FIXME: why not eval the function def together with the function call
+    ;; as in the commented out line below (it didn't work for some reason)
+    (ess-execute
+     (concat
+      ;; (replace-regexp-in-string "\n" " " org-R-write-org-table-def) ";"
+      (org-R-make-expr R-function csv-file options)) nil transit-buffer)
+
+    (save-excursion
+      (set-buffer (concat "*" transit-buffer "*"))
+      (unless (or (looking-at "$")
+		  (string-equal (buffer-substring-no-properties 1 2) "|"))
+	(error "Error in R evaluation:\n%s" (buffer-string))))
+    
+    
+    (if csv-file
+	(unless (and infile
+		     (string-equal (file-name-extension infile) "csv"))
+	  (delete-file csv-file)))
+  
+    (if graphics-output-file (ess-execute "dev.off()")) ;; Close graphics device
+    
+    (unless (or graphics-output-file
+		(not (plist-get options :output-to-buffer)))
+      ;; Send tabular output to a org buffer as new org
+      ;; table. Recall that we are currently at the beginning of the
+      ;; first #+R line
+      (if (and output-file graphics-output-file)
+	  (error "output-to-buffer and graphics-output-file both t"))
+		
+      (save-excursion
+	(if output-file
+	    (progn (set-buffer (find-file-noselect output-file))
+		   (delete-region (point-min) (point-max)))
+	  (if (plist-get options :replace)
+	      (progn ;; kill a table iff in one or one ends on the previous line
+		(delete-region (org-table-begin) (org-table-end))
+		(save-excursion 
+		  (forward-line -1)
+		  (if (looking-at "#\\+TBLNAME")
+		      (delete-region (point) (1+ (point-at-eol))))))))
+	(if title (insert "#+TBLNAME:" title "\n"))
+	(insert-buffer-substring (concat "*" transit-buffer "*"))
+	(org-table-align)
+	(if output-file (save-buffer))))
+
+    ;; We might be linking to graphical output, or to org output in
+    ;; another file. Either way, point is still at the beginning of
+    ;; the first #+R line.
+    (unless (not output-file)
+      (save-excursion 
+	(forward-line -1)
+	(if (looking-at "\\[\\[file:")
+	    (delete-region (point) (1+ (point-at-eol)))))
+      (insert (org-make-link-string 
+	       (concat "file:" output-file)
+	       (unless (plist-get options :inline)
+		 (or title (concat output-format " output")))) "\n"))
+
+    (kill-buffer (concat "*" transit-buffer "*"))))
+
+
+(defun org-R-export-to-csv (csv-file options)
+  "Find and export org table to csv.
+
+If the intable: option has not been supplied, then the table must
+end on the line immediately above the #+R lines. Otherwise,
+the remote table referenced by the intable: option is found using
+org-R-find-table. If options:infile has been set then this is the
+org file containing the table. See the docstring of
+org-R-find-table for details."
+  (let ((tbl-name-or-id (plist-get options :intable))
+	(org-file (plist-get options :infile)) tbl-marker)
+    
+    (if (and org-file
+	     (not (string-equal (file-name-extension org-file) "org")))
+	(error "File %s extension is not .csv so should be .org"))
+
+    (save-excursion
+      (if tbl-name-or-id
+	  ;; a remote table has been specified -- move into it
+	  (progn
+	    (if org-file (set-buffer (find-file-noselect org-file)))
+	    (setq tbl-marker (org-R-find-table tbl-name-or-id 'marker))
+	    (set-buffer (marker-buffer tbl-marker))
+	    (goto-char (marker-position tbl-marker)))
+	(forward-line -1)) ;; move into table above
+      (if (looking-at "[ \t]*|")
+	  (progn (org-table-export csv-file "orgtbl-to-csv") csv-file)
+	nil))))
+
+(defun org-R-find-table (name-or-id &optional markerp)
+  "Return location of a table.
+
+NAME-OR-ID may be the name of a
+table in the current file as set by a \"#+TBLNAME:\" directive.
+The first table following this line will then be used.
+Alternatively, it may be an ID referring to any entry, perhaps in
+a different file.  In this case, the first table in that entry
+will be referenced. The location is returned as a marker pointing
+to the beginning of the first line of the table.
+
+This is taken from the first part of org-table-get-remote-range
+in org-table.el.
+"
+  (cond
+   ((symbolp name-or-id) (setq name-or-id (symbol-name name-or-id)))
+   ((numberp name-or-id) (setq name-or-id (number-to-string name-or-id))))
+  (save-match-data
+    (let ((id-loc nil) (case-fold-search t) buffer loc)
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (save-excursion
+	    (goto-char (point-min))
+	    (if (re-search-forward
+		 (concat "^#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$")
+		 nil t)
+		;; OK, we've found a matching table name in this buffer.
+		(setq buffer (current-buffer) loc (match-beginning 0))
+	      ;; It's not a table name in this buffer. It must be an entry id.
+	      ;; obtain a marker pointing to it.
+	      (setq id-loc (org-id-find name-or-id 'marker)
+		    buffer (marker-buffer id-loc)
+		    loc (marker-position id-loc))
+	      (move-marker id-loc nil))) ;; disable the marker
+	  ;; (switch-to-buffer buffer)
+	  (set-buffer buffer)
+	  ;; OK, so now we're in the right buffer, and loc is either
+	  ;; the beginning of the #+TBLNAME line, or the location of the entry
+	  ;; either way we need to search forward to get to the beginning of the table
+	  (save-excursion
+	    (save-restriction
+	      (widen)
+	      (goto-char loc)
+	      (forward-char 1)
+	      ;; The following regexp search finds the beginning of
+	      ;; the next table in this entry. If it gets to the next
+	      ;; entry before the next table, then it signals failure.
+	      (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t)
+			   (not (match-beginning 1)))
+		(error "Cannot find a table at NAME or ID %s" name-or-id))
+	      (if markerp
+		  (move-marker (make-marker) (point-at-bol) (current-buffer))
+		(error "Option to return cons cell not implemented.
+                        It should return (file-name . position) to be 
+                        consistent with functions in org-id.el")))))))))
+
+(defun org-R-make-expr (R-function csv-file options)
+  "Construct R code to read data, analyse it and write output."
+
+  (let ((rownames (plist-get options :rownames))
+	(colnames (plist-get options :colnames))
+	(action (plist-get options :action))
+	(replace (plist-get options :replace)))
+
+    (if (and csv-file (symbolp csv-file))
+	(setq csv-file (symbol-name csv-file)))
+
+    (format "write.org.table((%s)(%s), write.rownames=%s)"
+	    R-function
+	    (if csv-file
+		(format
+		 "read.csv(\"%s\", header=%s, row.names=%s)"
+		 csv-file
+		  
+		 ;; Do we treat first row as colnames? Yes by default
+		 ;; FIXME: should really check for hline
+		 (if colnames "TRUE" "FALSE")
+
+		 ;; Do we use a column as rownames? Not unless rownames: is specified
+		 (if rownames "1" "NULL"))
+	      "NULL")
+
+	    ;; Do we write rownames into org table?
+	    (cond ((eq action 'tabulate)
+		   (if (eq (plist-get options :nxcols) 1) "FALSE" "TRUE"))
+		  ((eq action 'transpose) (if colnames "TRUE" "FALSE"))
+		  (rownames "TRUE")
+		  (t "TRUE")))))
+	    
+(defun org-R-get-options ()
+  "Parse the #+R: lines and return the options and values as a p-list."
+  (let ((opts '(
+		(:infile . "infile")
+		(:intable . "intable")
+		(:rownames . "rownames")
+		(:colnames . "colnames")
+		(:columns . "columns")
+
+		(:action . "action")
+		(:args . "args")
+		
+		(:outfile . "outfile")
+		(:replace . "replace")
+		(:title . "title")
+		(:legend . "legend")
+		(:colour . "colour")
+		(:color . "color")
+		(:col . "col")
+		(:height . "height")
+		(:width . "width")
+		(:lines . "lines")
+		(:sort . "sort")
+		(:inline . "inline")
+
+		(:output-to-buffer . "output-to-buffer")
+		
+		(:showcode . "showcode")))
+	(regexp ":\\(\"[^\"]*\"\\|(([^)]*) *([^)]*))\\|([^)]*)\\|[^ \t\n\r;,.]*\\)")
+	(case-fold-search t) p)
+
+    ;; FIXME: set default options properly
+    (setq p (plist-put p :output-to-buffer t)) ;; FIXME: hack: null options plist is bad news
+    (setq p (plist-put p :replace t))
+    (setq p (plist-put p :rownames nil))
+    (setq p (plist-put p :colnames t))
+    (setq p (plist-put p :inline nil))
+
+    (save-excursion
+      (while (looking-at "^#\\+\\(RR?:+\\) *\\(.*\\)")
+	(if (string= "R:" (match-string 1))
+	    (setq p (org-R-add-options-to-plist p (match-string 2) opts regexp)))
+	(forward-line)))
+    p))
+
+(defun org-R-add-options-to-plist (p opt-string op regexp)
+  "Parse a #+R: line and set values in the property list
+p. This function is adapted from similar functions in org-exp.el
+and org-plot.el. It might be a good idea to have a single
+function serving these three files' needs."
+  ;; Adapted from org-exp.el and org-plot.el
+  (let (o)
+    (when opt-string
+      (while (setq o (pop op))
+	(if (string-match 
+	     (concat (regexp-quote (cdr o)) regexp)
+	     opt-string)
+	    (setq p (plist-put p (car o)
+			       (car (read-from-string
+				     (match-string 1 opt-string)))))))))
+  p)
+
+
+(defun org-R-sanitise-options (options)
+  (error "not used yet")
+  (let (should-be-strings '(title legend colour color col csv)))
+  )
+(defun org-R-showcode (R)
+  "Display R function constructed by org-R in a new R-mode
+buffer"
+  (split-window-vertically)
+  (switch-to-buffer "*org-table.R*")
+  (kill-region (point-min) (point-max))
+  (R-mode)
+  (insert (replace-regexp-in-string 
+	   ";" "\n" (replace-regexp-in-string "\\([{}]\\)" "\n\\1\n" R)))
+  ;; (mark-whole-buffer)
+  ;; (indent-region)
+  ;; why doesn't that do what I hoped?
+  )
+
+(defun org-R-get-remote-range (name-or-id form)
+  "This is a refactoring of Carsten's original version. I have
+extracted the first bit of his function and named it
+org-R-find-table (which would presumably be called
+something like org-table-find-table or org-id-find-table if this
+were accepted).
+
+Get a field value or a list of values in a range from table at ID.
+
+NAME-OR-ID may be the name of a table in the current file as set by
+a \"#+TBLNAME:\" directive.  The first table following this line
+will then be used.  Alternatively, it may be an ID referring to
+any entry, possibly in a different file.  In this case, the first table
+in that entry will be referenced.
+FORM is a field or range descriptor like \"@2$3\" or or \"B3\" or
+\"@I$2..@II$2\".  All the references must be absolute, not relative.
+
+The return value is either a single string for a single field, or a
+list of the fields in the rectangle."
+
+  (let ((tbl-marker (org-R-find-table name-or-id 'marker))
+	org-table-column-names org-table-column-name-regexp
+	org-table-local-parameters org-table-named-field-locations
+	org-table-current-line-types org-table-current-begin-line
+	org-table-current-begin-pos org-table-dlines
+	org-table-hlines org-table-last-alignment
+	org-table-last-column-widths org-table-last-alignment
+	org-table-last-column-widths tbeg)
+
+    (save-excursion
+      (set-buffer (marker-buffer tbl-marker))
+      (goto-char (marker-position tbl-marker))
+      (org-table-get-specials)
+      (setq form (org-table-formula-substitute-names form))
+      (if (and (string-match org-table-range-regexp form)
+	       (> (length (match-string 0 form)) 1))
+	  (save-match-data
+	    (org-table-get-range (match-string 0 form) (point) 1))
+	form))))
+
+(provide 'org-R)

existing_tools/org-exp-blocks.el

@@ -0,0 +1,380 @@
+;;; org-exp-blocks.el --- pre-process blocks when exporting org files
+
+;; Copyright (C) 2008 Eric Schulte
+
+;; Author: Eric Schulte
+
+;; This file is not currently part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program ; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This is a utility for pre-processing blocks in org files before
+;; export using the `org-export-preprocess-hook'.  It can be used for
+;; exporting new types of blocks from org-mode files and also for
+;; changing the default export behavior of existing org-mode blocks.
+;; The `org-export-blocks' and `org-export-interblocks' alist can be
+;; used to control how blocks and the spaces between blocks
+;; respectively are processed upon export.
+;;
+;; The type of a block is defined as the string following =#+begin_=,
+;; so for example the following block would be of type ditaa.  Note
+;; that both upper or lower case are allowed in =#+BEGIN_= and
+;; =#+END_=.
+;;
+;; #+begin_ditaa blue.png -r -S
+;; +---------+
+;; | cBLU    |
+;; |         |
+;; |    +----+
+;; |    |cPNK|
+;; |    |    |
+;; +----+----+
+;; #+end_ditaa
+;;
+;;; Currently Implemented Block Types
+;;
+;; ditaa :: Convert ascii pictures to actual images using ditaa
+;;          http://ditaa.sourceforge.net/.  To use this set
+;;          `org-ditaa-jar-path' to the path to ditaa.jar on your
+;;          system (should be set automatically in most cases) .
+;;
+;; dot :: Convert graphs defined using the dot graphing language to
+;;        images using the dot utility.  For information on dot see
+;;        http://www.graphviz.org/
+;;
+;; comment :: Wrap comments with titles and author information, in
+;;            their own divs with author-specific ids allowing for css
+;;            coloring of comments based on the author.
+;;
+;; R :: Implements Sweave type exporting, evaluates blocks of R code,
+;;      and also replaces \R{} chunks in the file with their result
+;;      when passed to R.  This require the `R' command which is
+;;      provided by ESS (Emacs Speaks Statistics).
+
+(defcustom org-export-blocks
+  '((comment org-export-blocks-format-comment)
+    (ditaa org-export-blocks-format-ditaa)
+    (dot org-export-blocks-format-dot)
+    (r org-export-blocks-format-R)
+    (R org-export-blocks-format-R))
+  "Use this a-list to associate block types with block exporting
+functions.  The type of a block is determined by the text
+immediately following the '#+BEGIN_' portion of the block header.
+Each block export function should accept three argumets..."
+  :group 'org-export-general
+  :type 'alist)
+
+(defcustom org-export-interblocks
+  '((r org-export-interblocks-format-R)
+    (R org-export-interblocks-format-R))
+  "Use this a-list to associate block types with block exporting
+functions.  The type of a block is determined by the text
+immediately following the '#+BEGIN_' portion of the block header.
+Each block export function should accept three argumets..."
+  :group 'org-export-general
+  :type 'alist)
+
+(defcustom org-export-blocks-witheld
+  '(hidden)
+  "List of block types (see `org-export-blocks') which should not
+be exported."
+  :group 'org-export-general
+  :type 'list)
+
+(defvar org-export-blocks-postblock-hooks nil "")
+
+(defun org-export-blocks-html-quote (body &optional open close)
+  "Protext BODY from org html export.  The optional OPEN and
+CLOSE tags will be inserted around BODY."
+  (concat
+   "\n#+BEGIN_HTML\n"
+   (or open "")
+   body (if (string-match "\n$" body) "" "\n")
+   (or close "")
+   "#+END_HTML\n"))
+
+(defun org-export-blocks-latex-quote (body &optional open close)
+  "Protext BODY from org latex export.  The optional OPEN and
+CLOSE tags will be inserted around BODY."
+  (concat
+   "\n#+BEGIN_LaTeX\n"
+   (or open "")
+   body (if (string-match "\n$" body) "" "\n")
+   (or close "")
+   "#+END_LaTeX\n"))
+
+(defun org-export-blocks-preprocess ()
+  "Export all blocks acording to the `org-export-blocks' block
+exportation alist.  Does not export block types specified in
+specified in BLOCKS which default to the value of
+`org-export-blocks-witheld'."
+  (interactive)
+  (save-window-excursion
+    (let ((count 0)
+	  (blocks org-export-blocks-witheld)
+	  (case-fold-search t)
+	  (types '())
+	  type func start end)
+      (flet ((interblock (start end type)
+			 (save-match-data
+			   (when (setf func (cadr (assoc type org-export-interblocks)))
+			     (funcall func start end)))))
+	(goto-char (point-min))
+	(setf start (point))
+	(while (re-search-forward
+		"^#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)#\\+end_\\S-*[\r\n]" nil t)
+	  (save-match-data (setf type (intern (match-string 1))))
+	  (unless (memq type types) (setf types (cons type types)))
+	  (setf end (save-match-data (match-beginning 0)))
+	  (interblock start end type)
+	  (if (setf func (cadr (assoc type org-export-blocks)))
+	      (replace-match (save-match-data
+			       (if (memq type blocks)
+				   ""
+				 (apply func (match-string 3) (split-string (match-string 2) " ")))) t t))
+	  (setf start (save-match-data (match-end 0))))
+	(mapcar (lambda (type)
+		  (interblock start (point-max) type))
+		types)))))
+
+(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess)
+
+;;================================================================================
+;; type specific functions
+
+;;--------------------------------------------------------------------------------
+;; ditaa: create images from ASCII art using the ditaa utility
+(defvar org-ditaa-jar-path (expand-file-name
+			"ditaa.jar"
+			(file-name-as-directory
+			 (expand-file-name
+			  "scripts"
+			  (file-name-as-directory
+			   (expand-file-name
+			    ".."
+			    (file-name-directory (or load-file-name buffer-file-name)))))))
+  "Path to the ditaa jar executable")
+
+(defun org-export-blocks-format-ditaa (body &rest headers)
+  "Pass block BODY to the ditaa utility creating an image.
+Specify the path at which the image should be saved as the first
+element of headers, any additional elements of headers will be
+passed to the ditaa utility as command line arguments."
+  (message "ditaa-formatting...")
+  (let ((out-file (if headers (car headers)))
+	(args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
+	(data-file (make-temp-file "org-ditaa")))
+    (unless (file-exists-p org-ditaa-jar-path)
+      (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
+    (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body)
+		   body
+		 (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
+			    (org-split-string body "\n")
+			    "\n")))
+    (cond 
+     ((or htmlp latexp)
+      (with-temp-file data-file (insert body))
+      (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
+      (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
+      (format "\n[[file:%s]]\n" out-file))
+     (t (concat
+	 "\n#+BEGIN_EXAMPLE\n"
+	 body (if (string-match "\n$" body) "" "\n")
+	 "#+END_EXAMPLE\n")))))
+
+;;--------------------------------------------------------------------------------
+;; dot: create graphs using the dot graphing language
+;;      (require the dot executable to be in your path)
+(defun org-export-blocks-format-dot (body &rest headers)
+  "Pass block BODY to the dot graphing utility creating an image.
+Specify the path at which the image should be saved as the first
+element of headers, any additional elements of headers will be
+passed to the dot utility as command line arguments.  Don't
+forget to specify the output type for the dot command, so if you
+are exporting to a file with a name like 'image.png' you should
+include a '-Tpng' argument, and your block should look like the
+following.
+
+#+begin_dot models.png -Tpng
+digraph data_relationships {
+  \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
+  \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
+  \"data_requirement\" -> \"data_product\"
+}
+#+end_dot"
+  (message "dot-formatting...")
+  (let ((out-file (if headers (car headers)))
+	(args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
+	(data-file (make-temp-file "org-ditaa")))
+    (cond 
+     ((or htmlp latexp)
+      (with-temp-file data-file (insert body))
+      (message (concat "dot " data-file " " args " -o " out-file))
+      (shell-command (concat "dot " data-file " " args " -o " out-file))
+      (format "\n[[file:%s]]\n" out-file))
+     (t (concat
+	 "\n#+BEGIN_EXAMPLE\n"
+	 body (if (string-match "\n$" body) "" "\n")
+	 "#+END_EXAMPLE\n")))))
+
+;;--------------------------------------------------------------------------------
+;; comment: export comments in author-specific css-stylable divs
+(defun org-export-blocks-format-comment (body &rest headers)
+  "Format comment BODY by OWNER and return it formatted for export.
+Currently, this only does something for HTML export, for all
+other backends, it converts the comment into an EXAMPLE segment."
+  (let ((owner (if headers (car headers)))
+	(title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
+    (cond
+     (htmlp ;; We are exporting to HTML
+      (concat "#+BEGIN_HTML\n"
+	      "<div class=\"org-comment\""
+	      (if owner (format " id=\"org-comment-%s\" " owner))
+	      ">\n"
+	      (if owner (concat "<b>" owner "</b> ") "")
+	      (if (and title (> (length title) 0)) (concat " -- " title "</br>\n") "</br>\n")
+	      "<p>\n"
+	      "#+END_HTML\n"
+	      body
+	      "#+BEGIN_HTML\n"
+	      "</p>\n"
+	      "</div>\n"
+	      "#+END_HTML\n"))
+     (t ;; This is not HTML, so just make it an example.
+      (concat "#+BEGIN_EXAMPLE\n"
+	      (if title (concat "Title:" title "\n") "")
+	      (if owner (concat "By:" owner "\n") "")
+	      body
+	      (if (string-match "\n\\'" body) "" "\n")
+	      "#+END_EXAMPLE\n")))))
+
+;;--------------------------------------------------------------------------------
+;; R: Sweave-type functionality
+(defvar interblock-R-buffer nil
+  "Holds the buffer for the current R process")
+
+(defun org-export-blocks-format-R (body &rest headers)
+  "Process R blocks and replace \R{} forms outside the blocks
+with their values as determined by R."
+  (interactive)
+  (message "R processing...")
+  (let ((image-path (or (and (car headers)
+			     (string-match "\\(.?\\)\.\\(EPS\\|eps\\)" (car headers))
+			     (match-string 1 (car headers)))
+			(and (> (length (car headers)) 0)
+			     (car headers))
+			;; create the default filename
+			(format "Rplot-%03d" count)))
+	(plot (string-match "plot" body))
+	R-proc)
+    (setf count (+ count 1))
+    (interblock-initiate-R-buffer)
+    (setf R-proc (get-buffer-process interblock-R-buffer))
+    ;; send strings to the ESS process using `comint-send-string'
+    (setf body (mapconcat (lambda (line)
+			    (interblock-R-input-command line) (concat "> " line))
+			  (butlast (split-string body "[\r\n]"))
+			  "\n"))
+    ;; if there is a plot command, then create the images
+    (when plot
+      (interblock-R-input-command (format "dev.copy2eps(file=\"%s.eps\")" image-path)))
+    (concat (cond
+	     (htmlp (org-export-blocks-html-quote body
+						  (format "<div id=\"R-%d\">\n<pre>\n" count)
+						  "</pre>\n</div>\n"))
+	     (latexp (org-export-blocks-latex-quote body
+						    "\\begin{Schunk}\n\\begin{Sinput}\n"
+						    "\\end{Sinput}\n\\end{Schunk}\n"))
+	     (t (insert ;; default export
+		 "#+begin_R " (mapconcat 'identity headers " ") "\n"
+		 body (if (string-match "\n$" body) "" "\n")
+		 "#+end_R\n")))
+	    (if plot
+		(format "[[file:%s.eps]]\n" image-path)
+	      ""))))
+
+(defun org-export-interblocks-format-R (start end)
+  "This is run over parts of the org-file which are between R
+blocks.  It's main use is to expand the \R{stuff} chunks for
+export."
+  (save-excursion
+    (goto-char start)
+    (interblock-initiate-R-buffer)
+    (let (code replacement)
+      (while (and (< (point) end) (re-search-forward "\\\\R{\\(.*\\)}" end t))
+	(save-match-data (setf code (match-string 1)))
+	(setf replacement (interblock-R-command-to-string code))
+	(setf replacement (cond
+			   (htmlp replacement)
+			   (latexp replacement)
+			   (t replacement)))
+	(setf end (+ end (- (length replacement) (length code))))
+	(replace-match replacement t t)))))
+
+(defun interblock-initiate-R-buffer ()
+  "If there is not a current R process then create one."
+  (unless (and (buffer-live-p interblock-R-buffer) (get-buffer interblock-R-buffer))
+    (save-excursion
+      (R)
+      (setf interblock-R-buffer (current-buffer))
+      (interblock-R-wait-for-output)
+      (interblock-R-input-command ""))))
+
+(defun interblock-R-command-to-string (command)
+  "Send a command to R, and return the results as a string."
+  (interblock-R-input-command command)
+  (interblock-R-last-output))
+
+(defun interblock-R-input-command (command)
+  "Pass COMMAND to the R process running in `interblock-R-buffer'."
+  (save-excursion
+    (save-match-data
+      (set-buffer interblock-R-buffer)
+      (goto-char (process-mark (get-buffer-process (current-buffer))))
+      (insert command)
+      (comint-send-input)
+      (interblock-R-wait-for-output))))
+
+(defun interblock-R-wait-for-output ()
+  "Wait until output arrives"
+  (save-excursion
+    (save-match-data
+      (set-buffer interblock-R-buffer)
+      (while (progn
+	       (goto-char comint-last-input-end)
+	       (not (re-search-forward comint-prompt-regexp nil t)))
+	(accept-process-output (get-buffer-process (current-buffer)))))))
+
+(defun interblock-R-last-output ()
+  "Return the last R output as a string"
+  (save-excursion
+    (save-match-data
+      (set-buffer interblock-R-buffer)
+      (goto-char (process-mark (get-buffer-process (current-buffer))))
+      (forward-line 0)
+      (let ((raw (buffer-substring comint-last-input-end (- (point) 1))))
+	(if (string-match "\n" raw)
+	    raw
+	  (and (string-match "\\[[[:digit:]+]\\] *\\(.*\\)$" raw)
+	       (message raw)
+	       (message (match-string 1 raw))
+	       (match-string 1 raw)))))))
+
+(provide 'org-exp-blocks)
+
+;;; org-exp-blocks.el ends here

rorg.org

@@ -0,0 +1,22 @@
+#+TITLE: rorg --- R and org-mode
+
+Please feel free to change the layout of this file, I'm just putting
+this here to get things started.
+
+* objectives
+What are these?
+
+I'll pre-populate with a quick list from the email to get started
+
+Just to get this out there, there seem to be four kinds of
+functionality we're trying to get here:
+1. import data into R from org
+2. easy editing of R code using r-mode from an org buffer
+3. evaluate R code and make the output available for processing in an
+   org buffer
+4. evaluate R code and format the output for export
+
+
+* tasks
+
+