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

lisp/ob-R.el

@@ -37,6 +37,7 @@
 (declare-function R "ext:essd-r" (&optional start-args))
 (declare-function inferior-ess-send-input "ext:ess-inf" ())
 (declare-function ess-make-buffer-current "ext:ess-inf" ())
+(declare-function ess-eval-buffer "ext:ess-inf" (vis))
 
 (defconst org-babel-header-arg-names:R
   '(width height bg units pointsize antialias quality compression
@@ -217,9 +218,7 @@ current code buffer."
 
 (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}
-write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)")
-(defvar org-babel-R-wrapper-lastvar "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)")
+(defvar org-babel-R-write-object-command "{function(object, transfer.file) {invisible(if(inherits(try(write.table(object, file=transfer.file, sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE), silent=TRUE),\"try-error\")) {if(!file.exists(transfer.file)) file.create(transfer.file)})}}(object=%s, transfer.file=\"%s\")")
 
 (defun org-babel-R-evaluate
   (session body result-type column-names-p row-names-p)
@@ -238,17 +237,17 @@ string. If RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
   (case result-type
     (value
-     (let ((tmp-file (org-babel-temp-file "R-results-")))
+     (let ((tmp-file (org-babel-temp-file "R-")))
        (org-babel-eval org-babel-R-command
-		       (format org-babel-R-wrapper-method
-			       body tmp-file
+		       (format org-babel-R-write-object-command
 			       (if row-names-p "TRUE" "FALSE")
 			       (if column-names-p
 				   (if row-names-p "NA" "TRUE")
-				 "FALSE")))
+				 "FALSE")
+			       (format "{function ()\n{\n%s\n}}()" body)
+			       (org-babel-tramp-localname tmp-file)))
        (org-babel-R-process-value-result
-	(org-babel-import-elisp-from-file
-	 (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p)))
+	(org-babel-import-elisp-from-file tmp-file '(16)) column-names-p)))
     (output (org-babel-eval org-babel-R-command body))))
 
 (defun org-babel-R-evaluate-session
@@ -259,24 +258,22 @@ string. If RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
   (case result-type
     (value
-     (let ((tmp-file (org-babel-temp-file "R-"))
-	   broke)
-       (org-babel-comint-with-output (session org-babel-R-eoe-output)
-	 (insert (mapconcat
-		  #'org-babel-chomp
-		  (list
-		   body
-		   (format org-babel-R-wrapper-lastvar
-			   tmp-file
-			   (if row-names-p "TRUE" "FALSE")
-			   (if column-names-p
-			       (if row-names-p "NA" "TRUE")
-			     "FALSE"))
-		   org-babel-R-eoe-indicator) "\n"))
-	 (inferior-ess-send-input))
+     (with-temp-buffer
+       (insert (org-babel-chomp body))
+       (let ((ess-local-process-name
+	      (process-name (get-buffer-process session))))
+	 (ess-eval-buffer nil)))
+     (let ((tmp-file (org-babel-temp-file "R-")))
+       (org-babel-comint-eval-invisibly-and-wait-for-file
+	session tmp-file
+	(format org-babel-R-write-object-command
+		(if row-names-p "TRUE" "FALSE")
+		(if column-names-p
+		    (if row-names-p "NA" "TRUE")
+		  "FALSE")
+		".Last.value" (org-babel-tramp-localname tmp-file)))
        (org-babel-R-process-value-result
-	(org-babel-import-elisp-from-file
-	 (org-babel-maybe-remote-file tmp-file) '(16))  column-names-p)))
+	(org-babel-import-elisp-from-file tmp-file '(16))  column-names-p)))
     (output
      (mapconcat
       #'org-babel-chomp

lisp/ob-comint.el

@@ -34,6 +34,8 @@
 (require 'ob)
 (require 'comint)
 (eval-when-compile (require 'cl))
+(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
+(declare-function tramp-flush-directory-property "tramp" (vec directory))
 
 (defun org-babel-comint-buffer-livep (buffer)
   "Check if BUFFER is a comint buffer with a live process."
@@ -136,6 +138,24 @@ statement (not large blocks of code)."
                                 "comint-highlight-prompt"))))
       (accept-process-output (get-buffer-process buffer)))))
 
+(defun org-babel-comint-eval-invisibly-and-wait-for-file
+  (buffer file string &optional period)
+  "Evaluate STRING in BUFFER invisibly.
+Don't return until FILE exists. Code in STRING must ensure that
+FILE exists at end of evaluation."
+  (unless (org-babel-comint-buffer-livep buffer)
+    (error "buffer %s doesn't exist or has no process" buffer))
+  (if (file-exists-p file) (delete-file file))
+  (process-send-string
+   (get-buffer-process buffer)
+   (if (string-match "\n$" string) string (concat string "\n")))
+  ;; From Tramp 2.1.19 the following cache flush is not necessary
+  (if (file-remote-p default-directory)
+      (let (v)
+	(with-parsed-tramp-file-name default-directory nil
+	  (tramp-flush-directory-property v ""))))
+  (while (not (file-exists-p file)) (sit-for (or period 0.25))))
+
 (provide 'ob-comint)
 
 ;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889

lisp/ob-scheme.el

@@ -35,14 +35,25 @@
 
 ;; - a working scheme implementation
 ;;   (e.g. guile http://www.gnu.org/software/guile/guile.html)
+;;   
+;; - for session based evaluation cmuscheme.el is required which is
+;;   included in Emacs
 
 ;;; Code:
 (require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
 (require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(declare-function run-scheme "ext:cmuscheme" (cmd))
 
 (defvar org-babel-default-header-args:scheme '()
   "Default header arguments for scheme code blocks.")
 
+(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
+  "String to indicate that evaluation has completed.")
+
 (defcustom org-babel-scheme-cmd "guile"
   "Name of command used to evaluate scheme blocks."
   :group 'org-babel
@@ -59,17 +70,25 @@
                 ")\n" body ")")
       body)))
 
+(defvar scheme-program-name)
 (defun org-babel-execute:scheme (body params)
   "Execute a block of Scheme code with org-babel.
 This function is called by `org-babel-execute-src-block'"
   (let* ((processed-params (org-babel-process-params params))
-	 (session (not (string= (nth 0 processed-params) "none")))
          (result-type (nth 3 processed-params))
+	 (org-babel-scheme-cmd (or (cdr (assoc :scheme params)) org-babel-scheme-cmd))
          (full-body (org-babel-expand-body:scheme body params processed-params)))
     (read
-     (if session
+     (if (not (string= (nth 0 processed-params) "none"))
          ;; session evaluation
-         (error "Scheme sessions are not yet supported.")
+	 (let ((session (org-babel-prep-session:scheme
+			 (nth 0 processed-params) params)))
+	   (org-babel-comint-with-output
+	       (session (format "%S" org-babel-scheme-eoe) t body)
+	     (mapc
+	      (lambda (line)
+		(insert (org-babel-chomp line)) (comint-send-input nil t))
+	      (list body (format "%S" org-babel-scheme-eoe)))))
        ;; external evaluation
        (let ((script-file (org-babel-temp-file "lisp-script-")))
          (with-temp-file script-file
@@ -83,12 +102,34 @@ This function is called by `org-babel-execute-src-block'"
 
 (defun org-babel-prep-session:scheme (session params)
   "Prepare SESSION according to the header arguments specified in PARAMS."
-  (error "not yet implemented"))
+  (let* ((session (org-babel-scheme-initiate-session session))
+	 (vars (org-babel-ref-variables params))
+	 (var-lines
+	  (mapcar
+	   (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
+	   vars)))
+    (when session
+      (org-babel-comint-in-buffer session
+	(sit-for .5) (goto-char (point-max))
+	(mapc (lambda (var)
+		(insert var) (comint-send-input nil t)
+		(org-babel-comint-wait-for-output session)
+		(sit-for .1) (goto-char (point-max))) var-lines)))
+    session))
 
 (defun org-babel-scheme-initiate-session (&optional session)
   "If there is not a current inferior-process-buffer in SESSION
 then create.  Return the initialized session."
-  (error "Scheme sessions are not yet supported."))
+  (require 'cmuscheme)
+  (unless (string= session "none")
+    (let ((session-buffer (save-window-excursion
+			    (run-scheme org-babel-scheme-cmd)
+			    (rename-buffer session)
+			    (current-buffer))))
+      (if (org-babel-comint-buffer-livep session-buffer)
+	  (progn (sit-for .25) session-buffer)
+        (sit-for .5)
+        (org-babel-scheme-initiate-session session)))))
 
 (provide 'ob-scheme)
 

lisp/ob.el

@@ -40,6 +40,7 @@
 (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
 (declare-function tramp-file-name-user "tramp" (vec))
 (declare-function tramp-file-name-host "tramp" (vec))
+(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
 (declare-function org-icompleting-read "org" (&rest args))
 (declare-function org-edit-src-code "org-src" 
                   (&optional context code edit-buffer-name quietp))
@@ -1671,6 +1672,14 @@ the remote connection."
         (concat "/" user (when user "@") host ":" file))
     file))
 
+(defun org-babel-tramp-localname (file)
+  "Return the local name component of FILE."
+  (if (file-remote-p file)
+      (let (localname)
+	(with-parsed-tramp-file-name file nil
+	  localname))
+    file))
+
 (defvar org-babel-temporary-directory
   (or (and (boundp 'org-babel-temporary-directory)
 	   org-babel-temporary-directory)
@@ -1684,10 +1693,16 @@ Emacs shutdown.")
 Passes PREFIX and SUFFIX directly to `make-temp-file' with the
 value of `temporary-file-directory' temporarily set to the value
 of `org-babel-temporary-directory'."
-  (let ((temporary-file-directory (expand-file-name
-				   org-babel-temporary-directory
-				   temporary-file-directory)))
-    (make-temp-file prefix nil suffix)))
+  (if (file-remote-p default-directory)
+      (make-temp-file
+       (concat (file-remote-p default-directory)
+	       (expand-file-name 
+		prefix temporary-file-directory)
+	       nil suffix))
+    (let ((temporary-file-directory (expand-file-name
+				     org-babel-temporary-directory
+				     temporary-file-directory)))
+      (make-temp-file prefix nil suffix))))
 
 (defun org-babel-remove-temporary-directory ()
   "Remove `org-babel-temporary-directory' on Emacs shutdown."