summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Schulte <schulte.eric@gmail.com>2010-07-04 09:48:12 -0700
committerEric Schulte <schulte.eric@gmail.com>2010-07-05 11:14:50 -0700
commitfd9bf712652791bffc4c60d8f0363d796b5b222e (patch)
tree69df8e215fd92edb93b2b7f18c707d7a8cae22f5
parent15b36e2380cf8c5750593ea4bc05c349b51ebae9 (diff)
downloadorg-mode-fd9bf712652791bffc4c60d8f0363d796b5b222e.tar.gz
babel: fixed sessions in python, extracted external eval into ob-eval
-rw-r--r--lisp/ob-eval.el256
-rw-r--r--lisp/ob-python.el159
-rw-r--r--lisp/ob.el195
3 files changed, 334 insertions, 276 deletions
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
new file mode 100644
index 0000000..23b93a8
--- /dev/null
+++ b/lisp/ob-eval.el
@@ -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
diff --git a/lisp/ob-python.el b/lisp/ob-python.el
index 865213e..89d9d84 100644
--- a/lisp/ob-python.el
+++ b/lisp/ob-python.el
@@ -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)
- (assq-delete-all session org-babel-python-buffers)))
+ (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))))
-
-(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.")
+ (org-babel-python-session-buffer
+ (org-babel-python-initiate-session-by-key session))))
+
(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,70 +189,67 @@ 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
- (format
- (if (member "pp" result-params)
- org-babel-python-pp-wrapper-method
- org-babel-python-wrapper-method)
- (mapconcat
- (lambda (line) (format "\t%s" line))
- (split-string
- (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))
- raw
- (org-babel-python-table-or-string raw)))))))
+ (case result-type
+ (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
+ org-babel-python-wrapper-method)
+ (mapconcat
+ (lambda (line) (format "\t%s" line))
+ (split-string
+ (org-remove-indentation
+ (org-babel-trim body))
+ "[\r\n]") "\n")
+ tmp-file))
+ ((lambda (raw)
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ 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))
- (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)
- (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))))))))))
+ (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)))
+ (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)))
+ (org-babel-eval-read-file tmp-file))))))))
(defun org-babel-python-read-string (string)
"Strip 's from around python string"
diff --git a/lisp/ob.el b/lisp/ob.el
index f515318..48bfa04 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -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