lisp/ob-comint.el

   1 ;;; ob-comint.el --- org-babel functions for interaction with comint buffers
   2
   3 ;; Copyright (C) 2009, 2010  Free Software Foundation, Inc.
   4
   5 ;; Author: Eric Schulte
   6 ;; Keywords: literate programming, reproducible research, comint
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 0.01
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; These functions build on comint to ease the sending and receiving
  28 ;; of commands and results from comint buffers.
  29
  30 ;; Note that the buffers in this file are analogous to sessions in
  31 ;; org-babel at large.
  32
  33 ;;; Code:
  34 (require 'ob)
  35 (require 'comint)
  36 (eval-when-compile (require 'cl))
  37
  38 (defun org-babel-comint-buffer-livep (buffer)
  39   "Check if BUFFER is a comint buffer with a live process."
  40   (let ((buffer (if buffer (get-buffer buffer))))
  41     (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer)))
  42
  43 (defmacro org-babel-comint-in-buffer (buffer &rest body)
  44   "Check BUFFER and execute BODY.
  45 BUFFER is checked with `org-babel-comint-buffer-livep'.  BODY is
  46 executed inside the protection of `save-window-excursion' and
  47 `save-match-data'."
  48   (declare (indent 1))
  49   `(save-excursion
  50      (save-match-data
  51        (unless (org-babel-comint-buffer-livep ,buffer)
  52          (error "buffer %s doesn't exist or has no process" ,buffer))
  53        (set-buffer ,buffer)
  54        ,@body)))
  55
  56 (defmacro org-babel-comint-with-output (meta &rest body)
  57   "Evaluate BODY in BUFFER and return process output.
  58 Will wait until EOE-INDICATOR appears in the output, then return
  59 all process output.  If REMOVE-ECHO and FULL-BODY are present and
  60 non-nil, then strip echo'd body from the returned output.  META
  61 should be a list containing the following where the last two
  62 elements are optional.
  63
  64  (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY)
  65
  66 This macro ensures that the filter is removed in case of an error
  67 or user `keyboard-quit' during execution of body."
  68   (declare (indent 1))
  69   (let ((buffer (car meta))
  70         (eoe-indicator (cadr meta))
  71         (remove-echo (cadr (cdr meta)))
  72         (full-body (cadr (cdr (cdr meta)))))
  73     `(org-babel-comint-in-buffer ,buffer
  74        (let ((string-buffer "") dangling-text raw)
  75          (flet ((my-filt (text)
  76                          (setq string-buffer (concat string-buffer text))))
  77            ;; setup filter
  78            (add-hook 'comint-output-filter-functions 'my-filt)
  79            (unwind-protect
  80                (progn
  81                  ;; got located, and save dangling text
  82                  (goto-char (process-mark (get-buffer-process (current-buffer))))
  83                  (let ((start (point))
  84                        (end (point-max)))
  85                    (setq dangling-text (buffer-substring start end))
  86                    (delete-region start end))
  87                  ;; pass FULL-BODY to process
  88                  ,@body
  89                  ;; wait for end-of-evaluation indicator
  90                  (while (progn
  91                           (goto-char comint-last-input-end)
  92                           (not (save-excursion
  93                                  (and (re-search-forward
  94                                        comint-prompt-regexp nil t)
  95                                       (re-search-forward
  96                                        (regexp-quote ,eoe-indicator) nil t)))))
  97                    (accept-process-output (get-buffer-process (current-buffer)))
  98                    ;; thought the following this would allow async
  99                    ;; background running, but I was wrong...
 100                    ;; (run-with-timer .5 .5 'accept-process-output
 101                    ;;            (get-buffer-process (current-buffer)))
 102                    )
 103                  ;; replace cut dangling text
 104                  (goto-char (process-mark (get-buffer-process (current-buffer))))
 105                  (insert dangling-text))
 106              ;; remove filter
 107              (remove-hook 'comint-output-filter-functions 'my-filt)))
 108          ;; remove echo'd FULL-BODY from input
 109          (if (and ,remove-echo ,full-body
 110                   (string-match
 111                    (replace-regexp-in-string
 112                     "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
 113                    string-buffer))
 114              (setq raw (substring string-buffer (match-end 0))))
 115          (split-string string-buffer comint-prompt-regexp)))))
 116
 117 (defun org-babel-comint-input-command (buffer cmd)
 118   "Pass CMD to BUFFER.
 119 The input will not be echoed."
 120   (org-babel-comint-in-buffer buffer
 121     (goto-char (process-mark (get-buffer-process buffer)))
 122     (insert cmd)
 123     (comint-send-input)
 124     (org-babel-comint-wait-for-output buffer)))
 125
 126 (defun org-babel-comint-wait-for-output (buffer)
 127   "Wait until output arrives from BUFFER.
 128 Note: this is only safe when waiting for the result of a single
 129 statement (not large blocks of code)."
 130   (org-babel-comint-in-buffer buffer
 131     (while (progn
 132              (goto-char comint-last-input-end)
 133              (not (and (re-search-forward comint-prompt-regexp nil t)
 134                        (goto-char (match-beginning 0))
 135                        (string= (face-name (face-at-point))
 136                                 "comint-highlight-prompt"))))
 137       (accept-process-output (get-buffer-process buffer)))))
 138
 139 (provide 'ob-comint)
 140
 141 ;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889
 142
 143 ;;; ob-comint.el ends here