Browse Source

clean up two macros in ob-comint

* lisp/ob-comint.el (org-babel-comint-with-output,
org-babel-comint-in-buffer): clean up code.

This patch replaces some deeply nested ca/dr calls with ‘nth’, and
replaces a setq/unwind-protect/setq incantation with a simple let
binding.  Finally, it also restructures ’org-babel-comint-in-buffer’
to not needlessly save/restore match and excursion data if the buffer
process is not live, and to use with-current-buffer instead of
save-excursion+set-buffer
(info "(elisp) Excursions")
Aaron Ecay 11 years ago
parent
commit
24fe50671e
1 changed files with 40 additions and 44 deletions
  1. 40 44
      lisp/ob-comint.el

+ 40 - 44
lisp/ob-comint.el

@@ -48,12 +48,12 @@ BUFFER is checked with `org-babel-comint-buffer-livep'.  BODY is
 executed inside the protection of `save-excursion' and
 executed inside the protection of `save-excursion' and
 `save-match-data'."
 `save-match-data'."
   (declare (indent 1))
   (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
      (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
+	 ,@body))))
 (def-edebug-spec org-babel-comint-in-buffer (form body))
 (def-edebug-spec org-babel-comint-in-buffer (form body))
 
 
 (defmacro org-babel-comint-with-output (meta &rest body)
 (defmacro org-babel-comint-with-output (meta &rest body)
@@ -69,46 +69,42 @@ elements are optional.
 This macro ensures that the filter is removed in case of an error
 This macro ensures that the filter is removed in case of an error
 or user `keyboard-quit' during execution of body."
 or user `keyboard-quit' during execution of body."
   (declare (indent 1))
   (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
     `(org-babel-comint-in-buffer ,buffer
-       (let ((string-buffer "") dangling-text raw)
-	 ;; 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)))
+       (let ((string-buffer "")
+	     (comint-output-filter-functions
+	      (cons (lambda (text) (setq string-buffer (concat string-buffer text)))
+		    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
 	 ;; remove echo'd FULL-BODY from input
 	 (if (and ,remove-echo ,full-body
 	 (if (and ,remove-echo ,full-body
 		  (string-match
 		  (string-match