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

This commit is contained in:
Carsten Dominik 2010-02-28 23:21:29 +01:00
commit dd7655edc0
5 changed files with 79 additions and 36 deletions

View File

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

View File

@ -178,7 +178,9 @@ last statement in BODY, as elisp."
tmp-file)) tmp-file))
;; (message "buffer=%s" (buffer-string)) ;; debugging ;; (message "buffer=%s" (buffer-string)) ;; debugging
(shell-command-on-region (point-min) (point-max) "python")) (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)) (if (or (member "code" result-params) (member "pp" result-params))
raw raw
(org-babel-python-table-or-string raw))))))) (org-babel-python-table-or-string raw)))))))

View File

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

View File

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

View File

@ -79,6 +79,12 @@ then run `org-babel-pop-to-session'."
(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe) (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 (defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no")) '((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no"))
"Default arguments to use when evaluating a source block.") "Default arguments to use when evaluating a source block.")
@ -208,8 +214,16 @@ block."
((member "value" result-params) 'value) ((member "value" result-params) 'value)
(t 'value))) (t 'value)))
(cmd (intern (concat "org-babel-execute:" lang))) (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) result)
;; (message "params=%S" params) ;; debugging ;; (message "params=%S" params) ;; debugging
(flet ((call-process-region (&rest args)
(apply 'org-babel-tramp-handle-call-process-region args)))
(unless (member lang org-babel-interpreters) (unless (member lang org-babel-interpreters)
(error "Language is not in `org-babel-interpreters': %s" lang)) (error "Language is not in `org-babel-interpreters': %s" lang))
(if (and (not arg) new-hash (equal new-hash old-hash)) (if (and (not arg) new-hash (equal new-hash old-hash))
@ -226,7 +240,7 @@ block."
(list (list result)) (list (list result))
result))) result)))
(org-babel-insert-result result result-params info new-hash) (org-babel-insert-result result result-params info new-hash)
result))) result))))
(defun org-babel-load-in-session (&optional arg info) (defun org-babel-load-in-session (&optional arg info)
"Load the body of the current source-code block. Evaluate the "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 (when val
;; (message "prop %s=%s" header-arg val) ;; debugging ;; (message "prop %s=%s" header-arg val) ;; debugging
(cons (intern (concat ":" header-arg)) val)))) (cons (intern (concat ":" header-arg)) val))))
'("cache" "cmdline" "exports" "file" "noweb" "results" (mapcar 'symbol-name org-babel-header-arg-names)))))
"session" "tangle" "var")))))
(defun org-babel-parse-src-block-match () (defun org-babel-parse-src-block-match ()
(let* ((lang (org-babel-clean-text-properties (match-string 1))) (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
(org-babel-chomp (org-babel-reverse-string string) regexp)) regexp)) (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) (provide 'org-babel)
;;; org-babel.el ends here ;;; org-babel.el ends here