Browse Source

babel: Introduce org-babel copy of shell-command-on-region

At this commit, org-babel-shell-command-on-region is a direct copy of
shell-command-on-region. In addition to switching to use the org-babel
version, we change the argument passed so that they agree with the
docstring of s-c-o-r.

Despite the change in arguments, the same behaviour results because
s-c-o-r does not behave as documented in emacs23. Future commits will
be able to fix these bugs in the org-babel version, as necessary.
Dan Davison 15 years ago
parent
commit
05986e95ea

+ 2 - 2
contrib/babel/lisp/langs/org-babel-R.el

@@ -147,13 +147,13 @@ last statement in BODY, as elisp."
           (output
 	   (with-temp-buffer
              (insert body)
-             (shell-command-on-region (point-min) (point-max) "R --slave --no-save" 'replace)
+             (org-babel-shell-command-on-region (point-min) (point-max) "R --slave --no-save" 'current-buffer 'replace)
              (buffer-string)))
           (value
 	   (with-temp-buffer
              (insert (format org-babel-R-wrapper-method
 			     body tmp-file (if column-names-p "TRUE" "FALSE")))
-	     (shell-command-on-region (point-min) (point-max) "R --no-save" 'replace))
+	     (org-babel-shell-command-on-region (point-min) (point-max) "R --no-save"))
 	   (org-babel-R-process-value-result
 	    (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file))
 	    column-names-p))))

+ 5 - 4
contrib/babel/lisp/langs/org-babel-clojure.el

@@ -224,17 +224,18 @@ or nil if \"none\" is specified"
       (output
        (with-temp-buffer
          (insert body)
-         (shell-command-on-region
+         (org-babel-shell-command-on-region
           (point-min) (point-max)
           (format "%s - " (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " "))
-          'replace)
+          'current-buffer 'replace)
          (buffer-string)))
       (value
        (let ((tmp-results-file (make-temp-file "clojure_babel_results_")))
          (with-temp-buffer
            (insert (format org-babel-clojure-wrapper-method body tmp-results-file tmp-results-file))
-	   (shell-command-on-region (point-min) (point-max)
-				    (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " ")))
+	   (org-babel-shell-command-on-region
+	    (point-min) (point-max)
+	    (format "%s - " (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " "))))
          (org-babel-clojure-table-or-string
           (with-temp-buffer (insert-file-contents (org-babel-maybe-remote-file tmp-results-file)) (buffer-string))))))))
 

+ 2 - 2
contrib/babel/lisp/langs/org-babel-perl.el

@@ -98,7 +98,7 @@ last statement in BODY, as elisp."
            (with-temp-buffer
              (insert body)
              ;; (message "buffer=%s" (buffer-string)) ;; debugging
-             (shell-command-on-region (point-min) (point-max) "perl" 'replace)
+             (org-babel-shell-command-on-region (point-min) (point-max) "perl" 'current-buffer 'replace)
              (buffer-string)))
           (value
            (let ((tmp-file (make-temp-file "perl-functional-results")))
@@ -114,7 +114,7 @@ last statement in BODY, as elisp."
 		   (org-remove-indentation (org-babel-trim body)) "[\r\n]") "\n")
 		 tmp-file))
                ;; (message "buffer=%s" (buffer-string)) ;; debugging
-               (shell-command-on-region (point-min) (point-max) "perl"))
+               (org-babel-shell-command-on-region (point-min) (point-max) "perl"))
 	     (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file))))))
     ;; comint session evaluation
     (error "Sessions are not supported for Perl.")))

+ 2 - 2
contrib/babel/lisp/langs/org-babel-python.el

@@ -161,7 +161,7 @@ last statement in BODY, as elisp."
            (with-temp-buffer
              (insert body)
              ;; (message "buffer=%s" (buffer-string)) ;; debugging
-             (shell-command-on-region (point-min) (point-max) "python" 'replace)
+             (org-babel-shell-command-on-region (point-min) (point-max) "python" 'current-buffer 'replace)
              (buffer-string)))
           (value
            (let ((tmp-file (make-temp-file "python-functional-results")))
@@ -177,7 +177,7 @@ last statement in BODY, as elisp."
 		   (org-remove-indentation (org-babel-trim body)) "[\r\n]") "\n")
 		 tmp-file))
                ;; (message "buffer=%s" (buffer-string)) ;; debugging
-               (shell-command-on-region (point-min) (point-max) "python"))
+               (org-babel-shell-command-on-region (point-min) (point-max) "python"))
              (let ((raw (with-temp-buffer
 			  (insert-file-contents (org-babel-maybe-remote-file tmp-file))
 			  (buffer-string))))

+ 2 - 2
contrib/babel/lisp/langs/org-babel-ruby.el

@@ -165,7 +165,7 @@ last statement in BODY, as elisp."
            (with-temp-buffer
              (insert body)
              ;; (message "buffer=%s" (buffer-string)) ;; debugging
-             (shell-command-on-region (point-min) (point-max) "ruby" 'replace)
+             (org-babel-shell-command-on-region (point-min) (point-max) "ruby" 'current-buffer 'replace)
              (buffer-string)))
           (value
            (let ((tmp-file (make-temp-file "ruby-functional-results")))
@@ -174,7 +174,7 @@ last statement in BODY, as elisp."
                                    org-babel-ruby-pp-wrapper-method
                                  org-babel-ruby-wrapper-method) body tmp-file))
                ;; (message "buffer=%s" (buffer-string)) ;; debugging
-               (shell-command-on-region (point-min) (point-max) "ruby"))
+               (org-babel-shell-command-on-region (point-min) (point-max) "ruby"))
              (let ((raw (with-temp-buffer
 			  (insert-file-contents (org-babel-maybe-remote-file tmp-file))
 			  (buffer-string))))

+ 1 - 1
contrib/babel/lisp/langs/org-babel-sh.el

@@ -133,7 +133,7 @@ last statement in BODY."
         (with-temp-buffer
           (insert body)
           ;; (message "buffer=%s" (buffer-string)) ;; debugging
-          (shell-command-on-region (point-min) (point-max) org-babel-sh-command 'replace)
+          (org-babel-shell-command-on-region (point-min) (point-max) org-babel-sh-command 'current-buffer 'replace)
 	  (case result-type
 	    (output (buffer-string))
 	    (value ;; TODO: figure out how to return non-output values from shell scripts

+ 184 - 0
contrib/babel/lisp/org-babel.el

@@ -1120,5 +1120,189 @@ Fixes a bug in `tramp-handle-call-process-region'."
         (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.
+
+A copy of the emacs 23.1.1 function.
+
+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 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 t 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-excursion
+		  (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 'org-babel)
 ;;; org-babel.el ends here