]> code.delx.au - gnu-emacs/blobdiff - lisp/org/ob-comint.el
Update copyright year to 2015
[gnu-emacs] / lisp / org / ob-comint.el
index 732f2766b28c20cc848f73e0979ac7232be06c82..bc6ee78081172b8f76f49efe7bb4b2536f9bd9fe 100644 (file)
@@ -1,11 +1,10 @@
 ;;; ob-comint.el --- org-babel functions for interaction with comint buffers
 
-;; Copyright (C) 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
 
 ;; Author: Eric Schulte
 ;; Keywords: literate programming, reproducible research, comint
 ;; Homepage: http://orgmode.org
-;; Version: 7.01
 
 ;; This file is part of GNU Emacs.
 
 ;; org-babel at large.
 
 ;;; Code:
-(require 'ob)
+(require 'ob-core)
+(require 'org-compat)
 (require 'comint)
 (eval-when-compile (require 'cl))
+(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
+(declare-function tramp-flush-directory-property "tramp" (vec directory))
 
 (defun org-babel-comint-buffer-livep (buffer)
   "Check if BUFFER is a comint buffer with a live process."
 (defmacro org-babel-comint-in-buffer (buffer &rest body)
   "Check BUFFER and execute BODY.
 BUFFER is checked with `org-babel-comint-buffer-livep'.  BODY is
-executed inside the protection of `save-window-excursion' and
+executed inside the protection of `save-excursion' and
 `save-match-data'."
   (declare (indent 1))
   `(save-excursion
      (save-match-data
        (unless (org-babel-comint-buffer-livep ,buffer)
-         (error "buffer %s doesn't exist or has no process" ,buffer))
+         (error "Buffer %s does not exist or has no process" ,buffer))
        (set-buffer ,buffer)
        ,@body)))
+(def-edebug-spec org-babel-comint-in-buffer (form body))
 
 (defmacro org-babel-comint-with-output (meta &rest body)
   "Evaluate BODY in BUFFER and return process output.
@@ -72,39 +75,40 @@ or user `keyboard-quit' during execution of body."
        (full-body (cadr (cdr (cdr meta)))))
     `(org-babel-comint-in-buffer ,buffer
        (let ((string-buffer "") dangling-text raw)
-        (flet ((my-filt (text)
-                        (setq string-buffer (concat string-buffer text))))
-          ;; setup filter
-          (add-hook 'comint-output-filter-functions 'my-filt)
-          (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
-                                      comint-prompt-regexp nil t)
-                                     (re-search-forward
-                                      (regexp-quote ,eoe-indicator) 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
-            (remove-hook 'comint-output-filter-functions 'my-filt)))
+        ;; setup filter
+        (setq 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)))
         ;; remove echo'd FULL-BODY from input
         (if (and ,remove-echo ,full-body
                  (string-match
@@ -113,6 +117,7 @@ or user `keyboard-quit' during execution of body."
                   string-buffer))
             (setq raw (substring string-buffer (match-end 0))))
         (split-string string-buffer comint-prompt-regexp)))))
+(def-edebug-spec org-babel-comint-with-output (sexp body))
 
 (defun org-babel-comint-input-command (buffer cmd)
   "Pass CMD to BUFFER.
@@ -136,8 +141,26 @@ statement (not large blocks of code)."
                                 "comint-highlight-prompt"))))
       (accept-process-output (get-buffer-process buffer)))))
 
+(defun org-babel-comint-eval-invisibly-and-wait-for-file
+  (buffer file string &optional period)
+  "Evaluate STRING in BUFFER invisibly.
+Don't return until FILE exists.  Code in STRING must ensure that
+FILE exists at end of evaluation."
+  (unless (org-babel-comint-buffer-livep buffer)
+    (error "Buffer %s does not exist or has no process" buffer))
+  (if (file-exists-p file) (delete-file file))
+  (process-send-string
+   (get-buffer-process buffer)
+   (if (string-match "\n$" string) string (concat string "\n")))
+  ;; From Tramp 2.1.19 the following cache flush is not necessary
+  (if (file-remote-p default-directory)
+      (let (v)
+       (with-parsed-tramp-file-name default-directory nil
+                                    (tramp-flush-directory-property v ""))))
+  (while (not (file-exists-p file)) (sit-for (or period 0.25))))
+
 (provide 'ob-comint)
 
-;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889
+
 
 ;;; ob-comint.el ends here