From 8b52bf09e0644cc5b6ea85e5248403fcd562f4f3 Mon Sep 17 00:00:00 2001
From: Dan Davison <davison@stats.ox.ac.uk>
Date: Mon, 19 Oct 2009 21:00:24 -0400
Subject: [PATCH] org-babel: capture graphical output from R

If a [:file filename.ext] header arg is provided, then all graphical
output from the source block is captured on disk, and output of the
source block is a link to the resulting file, as with the
graphics-only languages such as gnuplot, ditaa, dot, asymptote. An
attempt is made to find a graphics device corresponding to the file
extension (currently .png, .jpg, .jpeg, .tiff, .bmp, .pdf, .ps,
.postscript are recognised); if that fails, png format output is
created.

Additionally, values for several arguments to the R graphics
device can be passed using header args:

:width :height :bg :units :pointsize
:antialias :quality :compression :res :type
:family :title :fonts :version :paper :encoding
:pagecentre :colormodel :useDingbats :horizontal

Arguments to the R graphics device that are not supported as header
args can be passed as a string in R argument syntax, using the header
arg :R-dev-args

An example block is (although both bg and fg can be passed directly as
header args)

\#+begin_src R :file z.pdf :width 8 :height 8 :R-dev-args bg="olivedrab", fg="hotpink"
  plot(matrix(rnorm(100), ncol=2), type="l")
\#+end_src
---
 contrib/babel/lisp/langs/org-babel-R.el | 44 +++++++++++++++++++++++++++------
 1 file changed, 36 insertions(+), 8 deletions(-)

diff --git a/contrib/babel/lisp/langs/org-babel-R.el b/contrib/babel/lisp/langs/org-babel-R.el
index 1ef21db2..a45577e8 100644
--- a/contrib/babel/lisp/langs/org-babel-R.el
+++ b/contrib/babel/lisp/langs/org-babel-R.el
@@ -40,14 +40,17 @@
 called by `org-babel-execute-src-block' via multiple-value-bind."
   (message "executing R source code block...")
   (save-window-excursion
-    (let ((full-body (concat
-		      (mapconcat ;; define any variables
-		       (lambda (pair)
-			 (org-babel-R-assign-elisp (car pair) (cdr pair)))
-		       vars "\n") "\n" body "\n"))
-	  (session (org-babel-R-initiate-session session))
-	  (column-names-p (cdr (assoc :colnames params))))
-      (org-babel-R-evaluate session full-body result-type column-names-p))))
+    (let* ((session (org-babel-R-initiate-session session))
+	   (column-names-p (cdr (assoc :colnames params)))
+	   (out-file (cdr (assoc :file params)))
+	   (augmented-body
+	    (concat
+	     (if out-file (concat (org-babel-R-construct-graphics-device-call out-file params) "\n") "")
+	     (mapconcat ;; define any variables
+	      (lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair))) vars "\n")
+	     "\n" body "\n" (if out-file "dev.off()\n" "")))
+	   (result (org-babel-R-evaluate session augmented-body result-type column-names-p)))
+      (or out-file result))))
 
 (defun org-babel-prep-session:R (session params)
   "Prepare SESSION according to the header arguments specified in PARAMS."
@@ -87,6 +90,31 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
 	(rename-buffer (if (bufferp session) (buffer-name session)
 			 (if (stringp session) session (buffer-name)))) (current-buffer)))))
 
+(defun org-babel-R-construct-graphics-device-call (out-file params)
+  "Construct the call to the graphics device"
+  (let ((devices
+	 '((:bmp . "bmp")
+	   (:jpg . "jpeg")
+	   (:jpeg . "jpeg")
+	   (:tiff . "tiff")
+	   (:png . "png")
+	   (:pdf . "pdf")
+	   (:ps . "postscript")
+	   (:postscript . "postscript")))
+	(allowed-args '(:width :height :bg :units :pointsize
+			       :antialias :quality :compression :res :type
+			       :family :title :fonts :version :paper :encoding
+			       :pagecentre :colormodel :useDingbats :horizontal))
+	(device (and (string-match ".+\\.\\([^.]+\\)" out-file) (match-string 1 out-file)))
+	(extra-args (cdr (assq :R-dev-args params))) filearg args)
+    (setq device (or (and device (cdr (assq (intern (concat ":" device)) devices))) "png"))
+    (setq filearg (if (member device '("pdf" "postscript")) "file" "filename"))
+    (setq args (mapconcat (lambda (pair)
+			    (if (member (car pair) allowed-args)
+				(format ",%s=%s" (substring (symbol-name (car pair)) 1) (cdr pair)) ""))
+			  params ""))
+    (format "%s(%s=\"%s\"%s%s%s)\n" device filearg out-file args (if extra-args "," "") (or extra-args ""))))
+
 (defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
 (defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
 (defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n}
-- 
2.11.4.GIT