summaryrefslogtreecommitdiff
path: root/lisp/ob-comint.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/ob-comint.el')
-rw-r--r--lisp/ob-comint.el83
1 files changed, 40 insertions, 43 deletions
diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el
index 40bfaf7..7c768d3 100644
--- a/lisp/ob-comint.el
+++ b/lisp/ob-comint.el
@@ -48,12 +48,13 @@ BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
executed inside the protection of `save-excursion' and
`save-match-data'."
(declare (indent 1))
- `(save-excursion
+ `(progn
+ (unless (org-babel-comint-buffer-livep ,buffer)
+ (error "Buffer %s does not exist or has no process" ,buffer))
(save-match-data
- (unless (org-babel-comint-buffer-livep ,buffer)
- (error "Buffer %s does not exist or has no process" ,buffer))
- (set-buffer ,buffer)
- ,@body)))
+ (with-current-buffer ,buffer
+ (let ((comint-input-filter (lambda (input) nil)))
+ ,@body)))))
(def-edebug-spec org-babel-comint-in-buffer (form body))
(defmacro org-babel-comint-with-output (meta &rest body)
@@ -69,46 +70,42 @@ elements are optional.
This macro ensures that the filter is removed in case of an error
or user `keyboard-quit' during execution of body."
(declare (indent 1))
- (let ((buffer (car meta))
- (eoe-indicator (cadr meta))
- (remove-echo (cadr (cdr meta)))
- (full-body (cadr (cdr (cdr meta)))))
+ (let ((buffer (nth 0 meta))
+ (eoe-indicator (nth 1 meta))
+ (remove-echo (nth 2 meta))
+ (full-body (nth 3 meta)))
`(org-babel-comint-in-buffer ,buffer
- (let ((string-buffer "") dangling-text raw)
- ;; setup filter
- (setq comint-output-filter-functions
+ (let* ((string-buffer "")
+ (comint-output-filter-functions
(cons (lambda (text) (setq string-buffer (concat string-buffer text)))
comint-output-filter-functions))
- (unwind-protect
- (progn
- ;; got located, and save dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (let ((start (point))
- (end (point-max)))
- (setq dangling-text (buffer-substring start end))
- (delete-region start end))
- ;; pass FULL-BODY to process
- ,@body
- ;; wait for end-of-evaluation indicator
- (while (progn
- (goto-char comint-last-input-end)
- (not (save-excursion
- (and (re-search-forward
- (regexp-quote ,eoe-indicator) nil t)
- (re-search-forward
- comint-prompt-regexp nil t)))))
- (accept-process-output (get-buffer-process (current-buffer)))
- ;; thought the following this would allow async
- ;; background running, but I was wrong...
- ;; (run-with-timer .5 .5 'accept-process-output
- ;; (get-buffer-process (current-buffer)))
- )
- ;; replace cut dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (insert dangling-text))
- ;; remove filter
- (setq comint-output-filter-functions
- (cdr comint-output-filter-functions)))
+ dangling-text raw)
+ ;; got located, and save dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (let ((start (point))
+ (end (point-max)))
+ (setq dangling-text (buffer-substring start end))
+ (delete-region start end))
+ ;; pass FULL-BODY to process
+ ,@body
+ ;; wait for end-of-evaluation indicator
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (save-excursion
+ (and (re-search-forward
+ (regexp-quote ,eoe-indicator) nil t)
+ (re-search-forward
+ comint-prompt-regexp nil t)))))
+ (accept-process-output (get-buffer-process (current-buffer)))
+ ;; thought the following this would allow async
+ ;; background running, but I was wrong...
+ ;; (run-with-timer .5 .5 'accept-process-output
+ ;; (get-buffer-process (current-buffer)))
+ )
+ ;; replace cut dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert dangling-text)
+
;; remove echo'd FULL-BODY from input
(if (and ,remove-echo ,full-body
(string-match
@@ -151,7 +148,7 @@ FILE exists at end of evaluation."
(if (file-exists-p file) (delete-file file))
(process-send-string
(get-buffer-process buffer)
- (if (string-match "\n$" string) string (concat string "\n")))
+ (if (= (aref string (1- (length string))) ?\n) string (concat string "\n")))
;; From Tramp 2.1.19 the following cache flush is not necessary
(if (file-remote-p default-directory)
(let (v)