Browse Source

Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

Carsten Dominik 15 years ago
parent
commit
3feebe79d1

+ 16 - 12
contrib/babel/lisp/langs/org-babel-R.el

@@ -142,18 +142,22 @@ BODY, if RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
   (if (not session)
       ;; external process evaluation
-      (let ((tmp-file (make-temp-file "R-out-functional-results")))
-        (case result-type
-          (output
-	   (with-temp-buffer
-             (insert body)
-             (shell-command-on-region (point-min) (point-max) "R --slave --no-save" '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))
+      (case result-type
+	(output
+	 (with-temp-buffer
+	   (insert body)
+	   (org-babel-shell-command-on-region (point-min) (point-max) "R --slave --no-save" 'current-buffer 'replace)
+	   (buffer-string)))
+	(value
+	 (let* ((tmp-file (make-temp-file "R-out-functional-results")) exit-code
+		(stderr
+		 (with-temp-buffer
+		   (insert (format org-babel-R-wrapper-method
+				   body tmp-file (if column-names-p "TRUE" "FALSE")))
+		   (setq exit-code (org-babel-shell-command-on-region
+				    (point-min) (point-max) "R --no-save" nil 'replace (current-buffer)))
+		   (buffer-string))))
+	   (if (> exit-code 0) (org-babel-error-notify exit-code stderr))
 	   (org-babel-R-process-value-result
 	    (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file))
 	    column-names-p))))

+ 21 - 18
contrib/babel/lisp/langs/org-babel-clojure.el

@@ -219,24 +219,27 @@ or nil if \"none\" is specified"
 
 (defun org-babel-clojure-evaluate-external-process (buffer body &optional result-type)
   "Evaluate the body in an external process."
-  (save-window-excursion
-    (case result-type
-      (output
-       (with-temp-buffer
-         (insert body)
-         (shell-command-on-region
-          (point-min) (point-max)
-          (format "%s - " (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " "))
-          '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-clojure-table-or-string
-          (with-temp-buffer (insert-file-contents (org-babel-maybe-remote-file tmp-results-file)) (buffer-string))))))))
+  (save-excursion
+    (let ((cmd (format "%s -" (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " "))))
+      (case result-type
+	(output
+	 (with-temp-buffer
+	   (insert body)
+	   (org-babel-shell-command-on-region cmd (point-min) (point-max) 'current-buffer 'replace)
+	   (buffer-string)))
+	(value
+	 (let* ((tmp-file (make-temp-file "org-babel-clojure-results-")) exit-code
+		(stderr
+		 (with-temp-buffer
+		   (insert
+		    (format org-babel-clojure-wrapper-method body tmp-file tmp-file))
+		   (setq exit-code
+			 (org-babel-shell-command-on-region (point-min) (point-max) cmd nil 'replace (current-buffer)))
+		   (buffer-string))))
+	   (if (> exit-code 0) (org-babel-error-notify exit-code stderr))
+	   (org-babel-clojure-table-or-string
+	    (with-temp-buffer
+	      (insert-file-contents (org-babel-maybe-remote-file tmp-file)) (buffer-string)))))))))
 
 (defun org-babel-clojure-evaluate-session (buffer body &optional result-type)
   "Evaluate the body in the context of a clojure session"

+ 21 - 16
contrib/babel/lisp/langs/org-babel-perl.el

@@ -92,29 +92,34 @@ BODY, if RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
   (if (not session)
       ;; external process evaluation
-      (save-window-excursion
+      (save-excursion
         (case result-type
           (output
            (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")))
-             (with-temp-buffer
-               (insert
-		(format
-		 (if (member "pp" result-params)
-                     (error "Pretty-printing not implemented for perl")
-                   org-babel-perl-wrapper-method)
-		 (mapconcat
-		  (lambda (line) (format "\t%s" line))
-		  (split-string
-		   (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"))
+           (let* ((tmp-file (make-temp-file "perl-functional-results")) exit-code
+		 (stderr
+		  (with-temp-buffer
+		    (insert
+		     (format
+		      (if (member "pp" result-params)
+			  (error "Pretty-printing not implemented for perl")
+			org-babel-perl-wrapper-method)
+		      (mapconcat
+		       (lambda (line) (format "\t%s" line))
+		       (split-string
+			(org-remove-indentation (org-babel-trim body)) "[\r\n]") "\n")
+		      tmp-file))
+		    ;; (message "buffer=%s" (buffer-string)) ;; debugging
+		    (setq exit-code
+			  (org-babel-shell-command-on-region
+			   (point-min) (point-max) "perl" nil 'replace (current-buffer)))
+		    (buffer-string))))
+	     (if (> exit-code 0) (org-babel-error-notify exit-code stderr))
 	     (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file))))))
     ;; comint session evaluation
     (error "Sessions are not supported for Perl.")))

+ 20 - 16
contrib/babel/lisp/langs/org-babel-python.el

@@ -155,29 +155,33 @@ BODY, if RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
   (if (not session)
       ;; external process evaluation
-      (save-window-excursion
+      (save-excursion
         (case result-type
           (output
            (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")))
-             (with-temp-buffer
-               (insert
-		(format
-		 (if (member "pp" result-params)
-                     org-babel-python-pp-wrapper-method
-                   org-babel-python-wrapper-method)
-		 (mapconcat
-		  (lambda (line) (format "\t%s" line))
-		  (split-string
-		   (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"))
+           (let* ((tmp-file (make-temp-file "org-babel-python-results-")) exit-code
+		  (stderr
+		   (with-temp-buffer
+		     (insert
+		      (format
+		       (if (member "pp" result-params)
+			   org-babel-python-pp-wrapper-method
+			 org-babel-python-wrapper-method)
+		       (mapconcat
+			(lambda (line) (format "\t%s" line))
+			(split-string
+			 (org-remove-indentation (org-babel-trim body)) "[\r\n]") "\n")
+		       tmp-file))
+		     ;; (message "buffer=%s" (buffer-string)) ;; debugging
+		     (setq exit-code (org-babel-shell-command-on-region
+				      (point-min) (point-max) "python" nil 'replace (current-buffer)))
+		     (buffer-string))))
+	     (if (> exit-code 0) (org-babel-error-notify exit-code stderr))
              (let ((raw (with-temp-buffer
 			  (insert-file-contents (org-babel-maybe-remote-file tmp-file))
 			  (buffer-string))))

+ 13 - 9
contrib/babel/lisp/langs/org-babel-ruby.el

@@ -159,22 +159,26 @@ BODY, if RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
   (if (not session)
       ;; external process evaluation
-      (save-window-excursion
+      (save-excursion
         (case result-type
           (output
            (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")))
-             (with-temp-buffer
-               (insert (format (if (member "pp" result-params)
-                                   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"))
+           (let* ((tmp-file (make-temp-file "ruby-functional-results")) exit-code
+		  (stderr
+		   (with-temp-buffer
+		     (insert (format (if (member "pp" result-params)
+					 org-babel-ruby-pp-wrapper-method
+				       org-babel-ruby-wrapper-method) body tmp-file))
+		     ;; (message "buffer=%s" (buffer-string)) ;; debugging
+		     (setq exit-code
+			   (org-babel-shell-command-on-region (point-min) (point-max) "ruby" nil 'replace (current-buffer)))
+		     (buffer-string))))
+	     (if (> exit-code 0) (org-babel-error-notify exit-code stderr))
              (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

+ 209 - 16
contrib/babel/lisp/org-babel.el

@@ -1022,6 +1022,14 @@ block but are passed literally to the \"example-block\"."
         (nb-add (buffer-substring index (point-max)))))
     new-body))
 
+(defun org-babel-error-notify (exit-code stderr)
+  (message (format "Shell command exited with code %d" exit-code))
+  (let ((buf (get-buffer-create "*Org-Babel Error Output*")))
+    (with-current-buffer buf
+      (goto-char (point-max))
+      (save-excursion (insert stderr)))
+    (display-buffer buf)))
+
 (defun org-babel-clean-text-properties (text)
   "Strip all properties from text return."
   (set-text-properties 0 (length text) nil text) text)
@@ -1055,22 +1063,23 @@ This is taken almost directly from `org-read-prop'."
   "Read the results located at FILE-NAME into an elisp table.  If
 the table is trivial, then return it as a scalar."
   (let (result)
-    (with-temp-buffer
-      (condition-case nil
-          (progn
-            (org-table-import file-name nil)
-            (delete-file file-name)
-            (setq result (mapcar (lambda (row)
-                                   (mapcar #'org-babel-string-read row))
-                                 (org-table-to-lisp))))
-        (error nil)))
-    (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
-	(if (consp (car result))
-	    (if (null (cdr (car result)))
-		(caar result)
-	      result)
-	  (car result))
-      result)))
+    (save-window-excursion
+      (with-temp-buffer
+	(condition-case nil
+	    (progn
+	      (org-table-import file-name nil)
+	      (delete-file file-name)
+	      (setq result (mapcar (lambda (row)
+				     (mapcar #'org-babel-string-read row))
+				   (org-table-to-lisp))))
+	  (error nil)))
+      (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
+	  (if (consp (car result))
+	      (if (null (cdr (car result)))
+		  (caar result)
+		result)
+	    (car result))
+	result))))
 
 (defun org-babel-string-read (cell)
   "Strip nested \"s from around strings in exported R values."
@@ -1120,5 +1129,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.
+
+Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
+
+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 output-buffer 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

+ 2 - 0
doc/org.texi

@@ -2769,6 +2769,8 @@ file:/home/dominik/images/jupiter.jpg     @r{file, absolute path}
 /home/dominik/images/jupiter.jpg          @r{same as above}
 file:papers/last.pdf                      @r{file, relative path}
 ./papers/last.pdf                         @r{same as above}
+file:/myself@@some.where:papers/last.pdf   @r{file, path on remote machine}
+/myself@@some.where:papers/last.pdf        @r{same as above}
 file:sometextfile::NNN                    @r{file with line number to jump to}
 file:projects.org                         @r{another Org file}
 file:projects.org::some words             @r{text search in Org file}