1
0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-12-24 10:38:41 +00:00

babel: fixed sessions in python, extracted external eval into ob-eval

This commit is contained in:
Eric Schulte 2010-07-04 09:48:12 -07:00
parent 15b36e2380
commit fd9bf71265
3 changed files with 333 additions and 275 deletions

256
lisp/ob-eval.el Normal file
View File

@ -0,0 +1,256 @@
;;; ob-run.el --- org-babel functions for external code evaluation
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 0.01
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; These functions build existing Emacs support for executing external
;; shell commands.
;;; Code:
(require 'ob)
(eval-when-compile (require 'cl))
(defun org-babel-eval-error-notify (exit-code stderr)
"Open a buffer containing information from STDERR with a
message about the value of EXIT-CODE."
(let ((buf (get-buffer-create "*Org-Babel Error Output*")))
(with-current-buffer buf
(goto-char (point-max))
(save-excursion (insert stderr)))
(display-buffer buf))
(message "Babel evaluation exited with code %d" exit-code))
(defun org-babel-eval (cmd body)
"Run CMD on BODY, if CMD succeeds then return it's results,
otherwise display STDERR with `org-babel-eval-error-notify'."
(let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code)
(with-current-buffer err-buff (erase-buffer))
(with-temp-buffer
(insert body)
(setq exit-code
(org-babel-shell-command-on-region
(point-min) (point-max) cmd t 'replace err-buff))
(if (> exit-code 0)
(progn
(with-current-buffer err-buff
(org-babel-eval-error-notify exit-code (buffer-string)))
nil)
(buffer-string)))))
(defun org-babel-eval-read-file (file)
"Return the contents of FILE as a string."
(with-temp-buffer (insert-file-contents
(org-babel-maybe-remote-file tmp-file))
(buffer-string)))
(defun org-babel-shell-command-on-region (start end command
&optional output-buffer replace
error-buffer display-error-buffer)
"Execute string COMMAND in inferior shell with region as input.
Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it. Return the exit code of
COMMAND.
To specify a coding system for converting non-ASCII characters in
the input and output to the shell command, use
\\[universal-coding-system-argument] before this command. By
default, the input (from the current buffer) is encoded in the
same coding system that will be used to save the file,
`buffer-file-coding-system'. If the output is going to replace
the region, then it is decoded from that same coding system.
The noninteractive arguments are START, END, COMMAND,
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
If the command generates output, the output may be displayed
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there. Otherwise
it is displayed in the buffer `*Shell Command Output*'. The output
is available in that buffer in both cases.
If there is output and an error, a message about the error
appears at the end of the output.
If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it).
If REPLACE, the optional fifth argument, is non-nil, that means insert
the output in place of text from START to END, putting point and mark
around it.
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
were any errors. (This is always t, interactively.)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive (let (string)
(unless (mark)
(error "The mark is not set now, so there is no region"))
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
;; relocates them while we are in the minibuffer.
(setq string (read-shell-command "Shell command on region: "))
;; call-interactively recognizes region-beginning and
;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
string
current-prefix-arg
current-prefix-arg
shell-command-default-error-buffer
t)))
(let ((error-file
(if error-buffer
(make-temp-file
(expand-file-name "scor"
(or (unless (featurep 'xemacs)
small-temporary-file-directory)
temporary-file-directory)))
nil))
exit-status)
(if (or replace
(and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer)))))
;; Replace specified region with output from command.
(let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
(and replace (push-mark (point) 'nomsg))
(setq exit-status
(call-process-region start end shell-file-name t
(if error-file
(list output-buffer error-file)
t)
nil shell-command-switch command))
;; It is rude to delete a buffer which the command is not using.
;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
(and replace swap (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
(or output-buffer "*Shell Command Output*"))))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
(delete-region (max start end) (point-max))
(delete-region (point-min) (min start end))
(setq exit-status
(call-process-region (point-min) (point-max)
shell-file-name t
(if error-file
(list t error-file)
t)
nil shell-command-switch
command)))
;; Clear the output buffer, then run the command with
;; output there.
(let ((directory default-directory))
(save-current-buffer
(set-buffer buffer)
(setq buffer-read-only nil)
(if (not output-buffer)
(setq default-directory directory))
(erase-buffer)))
(setq exit-status
(call-process-region start end shell-file-name nil
(if error-file
(list buffer error-file)
buffer)
nil shell-command-switch command)))
;; Report the output.
(with-current-buffer buffer
(setq mode-line-process
(cond ((null exit-status)
" - Error")
((stringp exit-status)
(format " - Signal [%s]" exit-status))
((not (equal 0 exit-status))
(format " - Exit [%d]" exit-status)))))
(if (with-current-buffer buffer (> (point-max) (point-min)))
;; There's some output, display it
(display-message-or-buffer buffer)
;; No output; error?
(let ((output
(if (and error-file
(< 0 (nth 7 (file-attributes error-file))))
"some error output"
"no output")))
(cond ((null exit-status)
(message "(Shell command failed with error)"))
((equal 0 exit-status)
(message "(Shell command succeeded with %s)"
output))
((stringp exit-status)
(message "(Shell command killed by signal %s)"
exit-status))
(t
(message "(Shell command failed with code %d and %s)"
exit-status output))))
;; Don't kill: there might be useful info in the undo-log.
;; (kill-buffer buffer)
))))
(when (and error-file (file-exists-p error-file))
(if (< 0 (nth 7 (file-attributes error-file)))
(with-current-buffer (get-buffer-create error-buffer)
(let ((pos-from-end (- (point-max) (point))))
(or (bobp)
(insert "\f\n"))
;; Do no formatting while reading error file,
;; because that can run a shell command, and we
;; don't want that to cause an infinite recursion.
(format-insert-file error-file nil)
;; Put point after the inserted errors.
(goto-char (- (point-max) pos-from-end)))
(and display-error-buffer
(display-buffer (current-buffer)))))
(delete-file error-file))
exit-status))
(provide 'ob-run)
;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d
;;; ob-comint.el ends here

View File

@ -30,6 +30,7 @@
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-run)
(require (if (featurep 'xemacs) 'python-mode 'python))
(eval-when-compile (require 'cl))
@ -39,6 +40,9 @@
(defvar org-babel-default-header-args:python '())
(defvar org-babel-python-command "python"
"Name of command to use for executing python code.")
(defun org-babel-expand-body:python (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(concat
@ -59,14 +63,16 @@ called by `org-babel-execute-src-block'."
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:python
body params processed-params)) ;; then the source block body
body params processed-params))
(result (org-babel-python-evaluate
session full-body result-type result-params)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
(org-babel-pick-name (nth 4 processed-params)
(cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params)
(cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
@ -140,31 +146,25 @@ then create. Return the initialized session."
;; `py-shell' creates a buffer whose name is the value of
;; `py-which-bufname' with '*'s at the beginning and end
(let* ((bufname (if python-buffer
(replace-regexp-in-string "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) ; zap surrounding *
(replace-regexp-in-string ;; zap surrounding *
"^\\*\\([^*]+\\)\\*$" "\\1" python-buffer)
(concat "Python-" (symbol-name session))))
(py-which-bufname bufname)) ; avoid making a mess with buffer-local
(py-which-bufname bufname))
(py-shell)
(setq python-buffer (concat "*" bufname "*"))))
(t
(error "No function available for running an inferior python.")))
(setq org-babel-python-buffers (cons (cons session python-buffer)
(setq org-babel-python-buffers
(cons (cons session python-buffer)
(assq-delete-all session org-babel-python-buffers)))
session)))
(defun org-babel-python-initiate-session (&optional session params)
"Create a session named SESSION according to PARAMS."
(unless (string= session "none")
(org-babel-python-session-buffer (org-babel-python-initiate-session-by-key session))))
(org-babel-python-session-buffer
(org-babel-python-initiate-session-by-key session))))
(defvar org-babel-python-last-value-eval "_"
"When evaluated by Python this returns the return value of the last statement.")
(defvar org-babel-python-pp-last-value-eval
'("results = _"
"import pprint"
"org_babel_pp = pprint.PrettyPrinter()"
"org_babel_pp.pprint(results)")
"When evaluated by Python this pretty prints the value of the last statement.")
(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'"
"Used to indicate that evaluation is has completed.")
(defvar org-babel-python-wrapper-method
@ -189,19 +189,10 @@ BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(if (not buffer)
;; external process evaluation
(save-excursion
(case result-type
(output
(with-temp-buffer
(insert body)
;; (message "buffer=%s" (buffer-string)) ;; debugging
(org-babel-shell-command-on-region (point-min) (point-max) "python" 'current-buffer 'replace)
(buffer-string)))
(value
(let* ((tmp-file (make-temp-file "org-babel-python-results-")) exit-code
(stderr
(with-temp-buffer
(insert
(output (org-babel-eval org-babel-python-command body))
(value (let ((tmp-file (make-temp-file "org-babel-python-results-")))
(org-babel-eval org-babel-python-command
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
@ -209,50 +200,56 @@ last statement in BODY, as elisp."
(mapconcat
(lambda (line) (format "\t%s" line))
(split-string
(org-remove-indentation (org-babel-trim body)) "[\r\n]") "\n")
(org-remove-indentation
(org-babel-trim body))
"[\r\n]") "\n")
tmp-file))
;; (message "buffer=%s" (buffer-string)) ;; debugging
(setq exit-code (org-babel-shell-command-on-region
(point-min) (point-max) "python" nil 'replace (current-buffer)))
(buffer-string))))
(if (> exit-code 0) (org-babel-error-notify exit-code stderr))
(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))
((lambda (raw)
(if (or (member "code" result-params)
(member "pp" result-params))
raw
(org-babel-python-table-or-string raw)))))))
(org-babel-python-table-or-string raw)))
(org-babel-eval-read-file tmp-file)))))
;; comint session evaluation
(org-babel-comint-in-buffer buffer
(let* ((raw (org-babel-comint-with-output
(buffer org-babel-python-eoe-indicator t body)
;; for some reason python is fussy, and likes enters after every input
(let ((comint-process-echoes nil))
(flet ((dump-last-value (tmp-file pp)
(mapc
(lambda (statement) (insert statement) (comint-send-input))
(if pp
(list
"import pp"
(format "open('%s', 'w').write(pprint.pformat(_))" tmp-file))
(list (format "open('%s', 'w').write(str(_))" tmp-file)))))
(input-body (body)
(mapc (lambda (statement) (insert statement) (comint-send-input))
(split-string (org-babel-trim body) "[\r\n]+"))
(comint-send-input) (comint-send-input)
(if (member "pp" result-params)
(mapc (lambda (statement) (insert statement) (comint-send-input))
org-babel-python-pp-last-value-eval)
(insert org-babel-python-last-value-eval))
(comint-send-input) (comint-send-input)))
(case result-type
(output
(mapconcat
#'org-babel-trim
(butlast
(butlast
(org-babel-comint-with-output
(buffer org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(insert org-babel-python-eoe-indicator)
(comint-send-input))))) "\n"))
(value
((lambda (results)
(if (or (member "code" result-params) (member "pp" result-params))
results
(org-babel-python-table-or-string results)))
(let ((tmp-file (make-temp-file "org-babel-python-results-")))
(org-babel-comint-with-output
(buffer org-babel-python-eoe-indicator t body)
(let ((comint-process-echoes nil))
(input-body body)
(dump-last-value tmp-file (member "pp" result-params))
(comint-send-input) (comint-send-input)
(insert org-babel-python-eoe-indicator)
(comint-send-input))))
(raw (apply #'append ; split further
(mapcar #'(lambda (r)
(split-string r "[\r\n]+"))
raw)))
(results (delete org-babel-python-eoe-indicator
(cdr (member org-babel-python-eoe-indicator
(mapcar #'org-babel-trim raw))))))
(unless (or (member "code" result-params) (member "pp" result-params))
(setq results (mapcar #'org-babel-python-read-string results)))
(case result-type
(output (org-babel-trim (mapconcat #'identity (reverse (cdr results)) "\n")))
(value
(if (or (member "code" result-params) (member "pp" result-params))
(car results)
(org-babel-python-table-or-string (org-babel-trim (car results))))))))))
(comint-send-input)))
(org-babel-eval-read-file tmp-file))))))))
(defun org-babel-python-read-string (string)
"Strip 's from around python string"

View File

@ -1349,16 +1349,6 @@ block but are passed literally to the \"example-block\"."
(nb-add (buffer-substring index (point-max)))))
new-body))
(defun org-babel-error-notify (exit-code stderr)
"Open a buffer containing information from STDERR with a
message about the value of EXIT-CODE."
(message (format "Shell command exited with code %d" exit-code))
(let ((buf (get-buffer-create "*Org-Babel Error Output*")))
(with-current-buffer buf
(goto-char (point-max))
(save-excursion (insert stderr)))
(display-buffer buf)))
(defun org-babel-clean-text-properties (text)
"Strip all properties from text return."
(when text
@ -1471,191 +1461,6 @@ the remote connection."
(concat "/" user (when user "@") host ":" file))
file))
(defun org-babel-shell-command-on-region (start end command
&optional output-buffer replace
error-buffer display-error-buffer)
"Execute string COMMAND in inferior shell with region as input.
Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it. Return the exit code of
COMMAND.
To specify a coding system for converting non-ASCII characters in
the input and output to the shell command, use
\\[universal-coding-system-argument] before this command. By
default, the input (from the current buffer) is encoded in the
same coding system that will be used to save the file,
`buffer-file-coding-system'. If the output is going to replace
the region, then it is decoded from that same coding system.
The noninteractive arguments are START, END, COMMAND,
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
If the command generates output, the output may be displayed
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there. Otherwise
it is displayed in the buffer `*Shell Command Output*'. The output
is available in that buffer in both cases.
If there is output and an error, a message about the error
appears at the end of the output.
If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it).
If REPLACE, the optional fifth argument, is non-nil, that means insert
the output in place of text from START to END, putting point and mark
around it.
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
were any errors. (This is always t, interactively.)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive (let (string)
(unless (mark)
(error "The mark is not set now, so there is no region"))
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
;; relocates them while we are in the minibuffer.
(setq string (read-shell-command "Shell command on region: "))
;; call-interactively recognizes region-beginning and
;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
string
current-prefix-arg
current-prefix-arg
shell-command-default-error-buffer
t)))
(let ((error-file
(if error-buffer
(make-temp-file
(expand-file-name "scor"
(or (unless (featurep 'xemacs)
small-temporary-file-directory)
temporary-file-directory)))
nil))
exit-status)
(if (or replace
(and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer)))))
;; Replace specified region with output from command.
(let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
(and replace (push-mark (point) 'nomsg))
(setq exit-status
(call-process-region start end shell-file-name t
(if error-file
(list output-buffer error-file)
t)
nil shell-command-switch command))
;; It is rude to delete a buffer which the command is not using.
;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
(and replace swap (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
(or output-buffer "*Shell Command Output*"))))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
(delete-region (max start end) (point-max))
(delete-region (point-min) (min start end))
(setq exit-status
(call-process-region (point-min) (point-max)
shell-file-name t
(if error-file
(list t error-file)
t)
nil shell-command-switch
command)))
;; Clear the output buffer, then run the command with
;; output there.
(let ((directory default-directory))
(save-current-buffer
(set-buffer buffer)
(setq buffer-read-only nil)
(if (not output-buffer)
(setq default-directory directory))
(erase-buffer)))
(setq exit-status
(call-process-region start end shell-file-name nil
(if error-file
(list buffer error-file)
buffer)
nil shell-command-switch command)))
;; Report the output.
(with-current-buffer buffer
(setq mode-line-process
(cond ((null exit-status)
" - Error")
((stringp exit-status)
(format " - Signal [%s]" exit-status))
((not (equal 0 exit-status))
(format " - Exit [%d]" exit-status)))))
(if (with-current-buffer buffer (> (point-max) (point-min)))
;; There's some output, display it
(display-message-or-buffer buffer)
;; No output; error?
(let ((output
(if (and error-file
(< 0 (nth 7 (file-attributes error-file))))
"some error output"
"no output")))
(cond ((null exit-status)
(message "(Shell command failed with error)"))
((equal 0 exit-status)
(message "(Shell command succeeded with %s)"
output))
((stringp exit-status)
(message "(Shell command killed by signal %s)"
exit-status))
(t
(message "(Shell command failed with code %d and %s)"
exit-status output))))
;; Don't kill: there might be useful info in the undo-log.
;; (kill-buffer buffer)
))))
(when (and error-file (file-exists-p error-file))
(if (< 0 (nth 7 (file-attributes error-file)))
(with-current-buffer (get-buffer-create error-buffer)
(let ((pos-from-end (- (point-max) (point))))
(or (bobp)
(insert "\f\n"))
;; Do no formatting while reading error file,
;; because that can run a shell command, and we
;; don't want that to cause an infinite recursion.
(format-insert-file error-file nil)
;; Put point after the inserted errors.
(goto-char (- (point-max) pos-from-end)))
(and display-error-buffer
(display-buffer (current-buffer)))))
(delete-file error-file))
exit-status))
(provide 'ob)
;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1