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

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

@@ -39,9 +39,10 @@
   "Execute a block of R code with org-babel.  This function is
 called by `org-babel-execute-src-block'."
   (message "executing R source code block...")
-  (save-window-excursion
+  (save-excursion
     (let* ((processed-params (org-babel-process-params params))
            (result-type (fourth processed-params))
+	   (ess-ask-for-ess-directory (not (cdr (assoc :dir params))))
            (session (org-babel-R-initiate-session (first processed-params)))
            (vars (second processed-params))
 	   (column-names-p (and (cdr (assoc :colnames params))
@@ -86,7 +87,7 @@ called by `org-babel-execute-src-block'."
       (let ((transition-file (make-temp-file "org-babel-R-import")))
         ;; ensure VALUE has an orgtbl structure (depth of at least 2)
         (unless (listp (car value)) (setq value (list value)))
-        (with-temp-file transition-file
+        (with-temp-file (org-babel-maybe-remote-file transition-file)
           (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
           (insert "\n"))
         (format "%s <- read.table(\"%s\", header=%s, sep=\"\\t\", as.is=TRUE)"
@@ -141,21 +142,21 @@ BODY, if RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
   (if (not session)
       ;; external process evaluation
-      (let ((in-tmp-file (make-temp-file "R-in-functional-results"))
-            (out-tmp-file (make-temp-file "R-out-functional-results")))
+      (let ((tmp-file (make-temp-file "R-out-functional-results")))
         (case result-type
           (output
-           (with-temp-file in-tmp-file (insert body))
-           (shell-command-to-string (format "R --slave --no-save < '%s' > '%s'"
-					    in-tmp-file out-tmp-file))
-	   (with-temp-buffer (insert-file-contents out-tmp-file) (buffer-string)))
+	   (with-temp-buffer
+             (insert body)
+             (shell-command-on-region (point-min) (point-max) "R --slave --no-save" 'replace)
+             (buffer-string)))
           (value
-           (with-temp-file in-tmp-file
+	   (with-temp-buffer
              (insert (format org-babel-R-wrapper-method
-			     body out-tmp-file (if column-names-p "TRUE" "FALSE"))))
-           (shell-command (format "R --no-save < '%s'" in-tmp-file))
+			     body tmp-file (if column-names-p "TRUE" "FALSE")))
+	     (shell-command-on-region (point-min) (point-max) "R --no-save" 'replace))
 	   (org-babel-R-process-value-result
-	    (org-babel-import-elisp-from-file out-tmp-file) column-names-p))))
+	    (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file))
+	    column-names-p))))
     ;; comint session evaluation
     (org-babel-comint-in-buffer session
       (let* ((tmp-file (make-temp-file "org-babel-R"))
@@ -178,7 +179,9 @@ last statement in BODY, as elisp."
 	     broke results)
         (case result-type
           (value (org-babel-R-process-value-result
-		  (org-babel-import-elisp-from-file tmp-file) column-names-p))
+		  (org-babel-import-elisp-from-file
+		   (org-babel-maybe-remote-file tmp-file))
+		  column-names-p))
           (output
 	   (flet ((extractor
 		   (el)

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

@@ -178,7 +178,9 @@ last statement in BODY, as elisp."
 		 tmp-file))
                ;; (message "buffer=%s" (buffer-string)) ;; debugging
                (shell-command-on-region (point-min) (point-max) "python"))
-             (let ((raw (with-temp-buffer (insert-file-contents tmp-file) (buffer-string))))
+             (let ((raw (with-temp-buffer
+			  (insert-file-contents (org-babel-maybe-remote-file tmp-file))
+			  (buffer-string))))
                (if (or (member "code" result-params) (member "pp" result-params))
                    raw
                  (org-babel-python-table-or-string raw)))))))

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

@@ -175,8 +175,9 @@ last statement in BODY, as elisp."
                                  org-babel-ruby-wrapper-method) body tmp-file))
                ;; (message "buffer=%s" (buffer-string)) ;; debugging
                (shell-command-on-region (point-min) (point-max) "ruby"))
-             (let ((raw (with-temp-buffer (insert-file-contents tmp-file)
-                                          (buffer-string))))
+             (let ((raw (with-temp-buffer
+			  (insert-file-contents (org-babel-maybe-remote-file tmp-file))
+			  (buffer-string))))
                (if (or (member "code" result-params) (member "pp" result-params))
                    raw
                  (org-babel-ruby-table-or-string raw)))))))

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

@@ -45,7 +45,7 @@
 body inside the protection of `save-window-excursion' and
 `save-match-data'."
   (declare (indent 1))
-  `(save-window-excursion
+  `(save-excursion
      (save-match-data
        (unless (org-babel-comint-buffer-livep ,buffer)
          (error (format "buffer %s doesn't exist or has no process" ,buffer)))

contrib/babel/lisp/org-babel.el

@@ -79,6 +79,12 @@ then run `org-babel-pop-to-session'."
 
 (add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
 
+(defconst org-babel-header-arg-names
+  '(cache cmdline colnames dir exports file noweb results session tangle var)
+  "Common header arguments used by org-babel.  Note that
+individual languages may define their own language specific
+header arguments as well.")
+
 (defvar org-babel-default-header-args
   '((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no"))
   "Default arguments to use when evaluating a source block.")
@@ -208,25 +214,33 @@ block."
 			    ((member "value" result-params) 'value)
 			    (t 'value)))
          (cmd (intern (concat "org-babel-execute:" lang)))
+	 (dir (cdr (assoc :dir params)))
+	 (default-directory
+	   (or (and dir (if (string-match "/$" dir) dir (concat dir "/"))) default-directory))
+	 (call-process-region-original
+	  (if (boundp 'call-process-region-original) call-process-region-original
+	    (symbol-function 'call-process-region)))
          result)
     ;; (message "params=%S" params) ;; debugging
-    (unless (member lang org-babel-interpreters)
-      (error "Language is not in `org-babel-interpreters': %s" lang))
-    (if (and (not arg) new-hash (equal new-hash old-hash))
-        (save-excursion ;; return cached result
-          (goto-char (org-babel-where-is-src-block-result nil info))
-          (move-end-of-line 1) (forward-char 1)
-          (setq result (org-babel-read-result))
-          (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
-      (setq result (funcall cmd body params))
-      (if (eq result-type 'value)
-          (setq result (if (and (or (member "vector" result-params)
-                                    (member "table" result-params))
-                                (not (listp result)))
-                           (list (list result))
-                         result)))
-      (org-babel-insert-result result result-params info new-hash)
-      result)))
+    (flet ((call-process-region (&rest args)
+				(apply 'org-babel-tramp-handle-call-process-region args)))
+      (unless (member lang org-babel-interpreters)
+	(error "Language is not in `org-babel-interpreters': %s" lang))
+      (if (and (not arg) new-hash (equal new-hash old-hash))
+	  (save-excursion ;; return cached result
+	    (goto-char (org-babel-where-is-src-block-result nil info))
+	    (move-end-of-line 1) (forward-char 1)
+	    (setq result (org-babel-read-result))
+	    (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
+	(setq result (funcall cmd body params))
+	(if (eq result-type 'value)
+	    (setq result (if (and (or (member "vector" result-params)
+				      (member "table" result-params))
+				  (not (listp result)))
+			     (list (list result))
+			   result)))
+	(org-babel-insert-result result result-params info new-hash)
+	result))))
 
 (defun org-babel-load-in-session (&optional arg info)
   "Load the body of the current source-code block.  Evaluate the
@@ -507,8 +521,7 @@ may be specified in the properties of the current outline entry."
                (when val
                  ;; (message "prop %s=%s" header-arg val) ;; debugging
                  (cons (intern (concat ":" header-arg)) val))))
-           '("cache" "cmdline" "exports" "file" "noweb" "results"
-             "session" "tangle" "var")))))
+           (mapcar 'symbol-name org-babel-header-arg-names)))))
 
 (defun org-babel-parse-src-block-match ()
   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
@@ -1076,5 +1089,29 @@ overwritten by specifying a regexp as a second argument."
   (org-babel-chomp (org-babel-reverse-string
                     (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
 
+(defun org-babel-tramp-handle-call-process-region
+  (start end program &optional delete buffer display &rest args)
+  "Use tramp to handle call-process-region.
+Fixes a bug in `tramp-handle-call-process-region'."
+  (if (and (featurep 'tramp) (file-remote-p default-directory))
+      (let ((tmpfile (tramp-compat-make-temp-file "")))
+	(write-region start end tmpfile)
+	(when delete (delete-region start end))
+	(unwind-protect
+	    ;;	(apply 'call-process program tmpfile buffer display args) ;; bug in tramp
+	    (apply 'process-file program tmpfile buffer display args)
+	  (delete-file tmpfile)))
+    ;; call-process-region-original is the original emacs definition. It
+    ;; is in scope from the let binding in org-babel-execute-src-block
+    (apply call-process-region-original start end program delete buffer display args)))
+
+(defun org-babel-maybe-remote-file (file)
+  (if (file-remote-p default-directory)
+      (let* ((vec (tramp-dissect-file-name default-directory))
+             (user (tramp-file-name-user vec))
+             (host (tramp-file-name-host vec)))
+        (concat "/" user (when user "@") host ":" file))
+    file))
+
 (provide 'org-babel)
 ;;; org-babel.el ends here