Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

contrib/babel/lisp/langs/org-babel-R.el

@@ -33,21 +33,24 @@
 
 (org-babel-add-interpreter "R")
 
-(add-to-list 'org-babel-tangle-langs '("R" "r"))
+(add-to-list 'org-babel-tangle-langs '("R" "R" "#!/usr/bin/env Rscript"))
 
 (defun org-babel-execute:R (body params)
   "Execute a block of R code with org-babel.  This function is
 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}
@@ -127,6 +155,12 @@ last statement in BODY, as elisp."
 		 (mapconcat #'org-babel-chomp (list body org-babel-R-eoe-indicator) "\n"))))
 	     (raw (org-babel-comint-with-output buffer org-babel-R-eoe-output nil
                     (insert full-body) (inferior-ess-send-input)))
+	     (comint-prompt-regexp
+	      (concat "^\\("
+		      inferior-ess-primary-prompt
+		      "\\|"
+		      inferior-ess-secondary-prompt
+		      "\\)*"))
 	     broke results)
         (case result-type
           (value (org-babel-R-process-value-result

contrib/babel/lisp/langs/org-babel-emacs-lisp.el

@@ -39,16 +39,13 @@
   "Execute a block of emacs-lisp code with org-babel.  This
 function is called by `org-babel-execute-src-block' via multiple-value-bind."
   (message "executing emacs-lisp code block...")
-  (case result-type
-    (output '())
-    (value (save-window-excursion
-             (let ((print-level nil) (print-length nil))
-               (eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) vars)
-                        ,(read (concat "(progn "
-                                       (if (or (member "code" result-params)
-                                               (member "pp" result-params))
-                                           (concat "(pp " body ")") body)
-                                       ")")))))))))
-
+  (save-window-excursion
+    (let ((print-level nil) (print-length nil))
+      (eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) vars)
+	       ,(read (concat "(progn "
+			      (if (or (member "code" result-params)
+				      (member "pp" result-params))
+				  (concat "(pp " body ")") body)
+			      ")")))))))
 (provide 'org-babel-emacs-lisp)
 ;;; org-babel-emacs-lisp.el ends here

contrib/babel/lisp/org-babel-lob.el

@@ -55,7 +55,7 @@ add files to this list use the `org-babel-lob-ingest' command."
 
 ;; functions for executing lob one-liners
 
-(defvar org-babel-lob-one-liner-regexp "#\\+lob:[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)[ \t]*\\(\n\\|\\'\\)")
+(defvar org-babel-lob-one-liner-regexp "#\\+lob:[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)[ \t]*\\([^\n]*\\)")
 
 (defun org-babel-lob-execute-maybe ()
   "Detect if this is context for a org-babel Library Of Babel

contrib/babel/lisp/org-babel-ref.el

@@ -57,10 +57,12 @@
 (defun org-babel-ref-variables (params)
   "Takes a parameter alist, and return an alist of variable
 names, and the emacs-lisp representation of the related value."
-  (mapcar #'org-babel-ref-parse
-          (delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params))))
+  (let ((assignments
+	 (delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params)))
+	(other-params (assq-delete-all :var params)))
+    (mapcar (lambda (assignment) (org-babel-ref-parse assignment other-params)) assignments)))
 
-(defun org-babel-ref-parse (assignment)
+(defun org-babel-ref-parse (assignment params)
   "Parse a variable ASSIGNMENT in a header argument.  If the
 right hand side of the assignment has a literal value return that
 value, otherwise interpret as a reference to an external resource
@@ -74,7 +76,7 @@ emacs-lisp representation of the value of the variable."
             (ref (match-string 2 assignment)))
         (cons (intern var)
               (or (org-babel-ref-literal ref)
-                  (org-babel-ref-resolve-reference ref))))))
+                  (org-babel-ref-resolve-reference ref params))))))
 
 (defun org-babel-ref-literal (ref)
   "Determine if the right side of a header argument variable
@@ -83,11 +85,11 @@ resource.  If REF is literal then return it's value, otherwise
 return nil."
   (let ((out (org-babel-read ref)))
     (if (equal out ref)
-        (if (string-match "\"\\(.+\\)\"" ref)
+        (if (string-match "^\".+\"$" ref)
             (read ref))
       out)))
 
-(defun org-babel-ref-resolve-reference (ref)
+(defun org-babel-ref-resolve-reference (ref params)
   "Resolve the reference and return its value"
   (save-excursion
     (let ((case-fold-search t)
@@ -114,7 +116,7 @@ return nil."
             ;; goto ref in the current buffer
             (or (and (not args)
                      (or (re-search-forward result_regexp nil t)
-                         (re-search-forward result_regexp nil t)))
+                         (re-search-backward result_regexp nil t)))
                 (re-search-forward regexp nil t)
                 (re-search-backward regexp nil t)
                 ;; check the Library of Babel
@@ -134,14 +136,14 @@ return nil."
           (beginning-of-line)
           (if (or (= (point) (point-min)) (= (point) (point-max)))
               (error "reference not found"))))
-      ;; (message "type=%S" type) ;; debugging
-      (case type
-        ('results-line (org-babel-read-result))
-        ('table (org-babel-read-table))
-        ('source-block
-         (setq result (org-babel-execute-src-block t nil args))
-         (if (symbolp result) (format "%S" result) result))
-        ('lob (setq result (org-babel-execute-src-block t lob-info args)))))))
+      (setq params (org-babel-merge-params params args))
+      (setq result
+	    (case type
+	      ('results-line (org-babel-read-result))
+	      ('table (org-babel-read-table))
+	      ('source-block (org-babel-execute-src-block t nil params))
+	      ('lob (org-babel-execute-src-block t lob-info params))))
+      (if (symbolp result) (format "%S" result) result))))
 
 (defun org-babel-ref-split-args (arg-string)
   "Split ARG-STRING into top-level arguments of balanced parenthesis."

contrib/babel/lisp/org-babel-tangle.el

@@ -62,6 +62,7 @@ file using `load-file'."
 specify a default export file for all source blocks.  Optional
 argument LANG can be used to limit the exported source code
 blocks by language."
+  (interactive "fFile to tangle: \nP")
   (save-window-excursion (find-file file) (org-babel-tangle target-file lang)))
 
 (defun org-babel-tangle (&optional target-file lang)

contrib/babel/lisp/org-babel.el

@@ -189,7 +189,7 @@ the header arguments specified at the source code block."
     (if (eq result-type 'value)
         (setq result (org-babel-process-value-result result result-params)))
     (org-babel-insert-result result result-params)
-    (case result-type (output nil) (value result))))
+    result))
 
 (defun org-babel-load-in-session (&optional arg info)
   "Load the body of the current source-code block.  Evaluate the
@@ -360,7 +360,8 @@ may be specified in the properties of the current outline entry."
     (delq nil
           (mapcar
            (lambda (header-arg)
-             (let ((val (org-entry-get (point) header-arg)))
+             (let ((val (or (org-entry-get (point) header-arg 'selective)
+			    (cdr (assoc header-arg org-file-properties)))))
                (when val
                  ;; (message "param-from-property %s=%s" header-arg val) ;; debugging statement
                  (cons (intern (concat ":" header-arg)) val))))
@@ -673,6 +674,8 @@ parameters when merging lists."
 	 '(("file" "vector" "table" "scalar" "raw" "org" "html" "latex" "code" "pp")
 	   ("replace" "silent")
 	   ("output" "value")))
+	(exports-exclusive-groups
+	 '(("code" "results" "both" "none")))
 	params results exports tangle vars var ref)
     (flet ((e-merge (exclusive-groups &rest result-params)
                     ;; maintain exclusivity of mutually exclusive parameters
@@ -705,9 +708,11 @@ parameters when merging lists."
 			(:file
 			 (when (cdr pair)
 			   (setq results (e-merge results-exclusive-groups results '("file")))
+			   (unless (or (member "both" exports) (member "none" exports))
+			     (setq exports (e-merge exports-exclusive-groups exports '("results"))))
 			   (setq params (cons pair (assq-delete-all (car pair) params)))))
                         (:exports
-                         (setq exports (e-merge '(("code" "results" "both" "none"))
+                         (setq exports (e-merge exports-exclusive-groups
                                                 exports (split-string (cdr pair)))))
                         (:tangle
                          (setq tangle (e-merge '(("yes" "no"))