Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode
This commit is contained in:
Carsten Dominik
commit
dd7655edc0
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue