shell support is pretty much working

lisp/langs/org-babel-shell.el

@@ -1,4 +1,4 @@
-;;; org-babel-shell.el --- org-babel functions for shell execution
+;;; org-babel-shell.el --- org-babel functions for shell evaluation
 
 ;; Copyright (C) 2009 Eric Schulte
 
@@ -26,58 +26,108 @@
 
 ;;; Commentary:
 
-;; Org-Babel support for evaluating sh, bash, and zsh shells
+;; Org-Babel support for evaluating shell source code.
 
 ;;; Code:
 (require 'org-babel)
+(require 'shell)
 
-(defun org-babel-shell-add-interpreter (var cmds)
-  (set-default var cmds)
-  (mapc (lambda (cmd)
-          (org-babel-add-interpreter cmd)
-          (eval
-           `(defun ,(intern (concat "org-babel-execute:" cmd)) (body params)
-              ,(concat "Evaluate a block of " cmd " shell with org-babel. This function is
-called by `org-babel-execute-src-block'.  This function is an
-automatically generated wrapper for `org-babel-shell-execute'.")
-              (org-babel-shell-execute ,cmd body params))))
-        cmds))
-
-(defcustom org-babel-shell-interpreters '("sh" "bash" "zsh")
-  "List of interpreters of shelling languages which can be
-executed through org-babel."
-  :group 'org-babel
-  :set 'org-babel-shell-add-interpreter)
-
-(defun org-babel-shell-execute (cmd body params)
-  "Run CMD on BODY obeying any options set with PARAMS."
-  (message (format "executing %s code block..." cmd))
-  (let ((vars (org-babel-ref-variables params)))
-    (save-window-excursion
-      (with-temp-buffer
-        (if (> (length vars) 0)
-            (error "currently no support for passing variables to shells"))
-        (insert body)
-        (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
-        (org-babel-shell-to-elisp (buffer-string))))))
-
-(defun org-babel-shell-to-elisp (result)
-  (let ((tmp-file (make-temp-file "org-babel-shell")))
-    (with-temp-file tmp-file
-      (insert result))
-    (with-temp-buffer
-      (org-table-import tmp-file nil)
-      (delete-file tmp-file)
-      (setq result (mapcar (lambda (row)
-                             (mapcar #'org-babel-read row))
-                           (org-table-to-lisp)))
-      (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))))
+(org-babel-add-interpreter "sh")
+
+(defun org-babel-execute:sh (body params)
+  "Execute a block of Shell commands with org-babel.  This
+function is called by `org-babel-execute-src-block'."
+  (message "executing Shell command block")
+  (let* ((vars (org-babel-ref-variables params))
+         (result-params (split-string (or (cdr (assoc :results params)) "")))
+         (result-type (cond ((member "output" result-params) 'output)
+                            ((member "value" result-params) 'value)
+                            (t 'value)))
+         (full-body (concat
+                     (mapconcat ;; define any variables
+                      (lambda (pair)
+                        (format "%s=%s"
+                                (car pair)
+                                (org-babel-shell-var-to-shell (cdr pair))))
+                      vars "\n") "\n" body "\n\n")) ;; then the source block body
+         (session (org-babel-shell-initiate-session (cdr (assoc :session params))))
+         (results (org-babel-shell-evaluate session full-body result-type)))
+    (if (member "scalar" result-params)
+        results
+      (setq results (let ((tmp-file (make-temp-file "org-babel-ruby")))
+                      (with-temp-file tmp-file (insert results))
+                      (org-babel-import-elisp-from-file tmp-file)))
+      (if (and (member "vector" results) (not (listp results)))
+          (list (list results))
+        results))))
+
+(defun org-babel-shell-var-to-shell (var)
+  "Convert an elisp var into a string of shell commands
+specifying a var of the same value."
+  (if (listp var)
+      (concat "[" (mapconcat #'org-babel-shell-var-to-shell var ", ") "]")
+    (format "%S" var)))
+
+(defun org-babel-shell-table-or-results (results)
+  "If the results look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+  (org-babel-read
+   (if (string-match "^\\[.+\\]$" results)
+       (org-babel-read
+        (replace-regexp-in-string
+         "\\[" "(" (replace-regexp-in-string
+                    "\\]" ")" (replace-regexp-in-string
+                               ", " " " (replace-regexp-in-string
+                                         "'" "\"" results)))))
+     results)))
+
+;; functions for comint evaluation
+
+(defun org-babel-shell-initiate-session (&optional session)
+  "If there is not a current inferior-process-buffer in SESSION
+then create.  Return the initialized session."
+  (save-window-excursion (shell session) (current-buffer)))
+
+(defvar org-babel-shell-eoe-indicator "echo 'org_babel_shell_eoe'"
+  "Used to indicate that evaluation is has completed.")
+(defvar org-babel-shell-eoe-output "org_babel_shell_eoe"
+  "Used to indicate that evaluation is has completed.")
+
+(defun org-babel-shell-evaluate (buffer body &optional result-type)
+  "Pass BODY to the Shell process in BUFFER.  If RESULT-TYPE equals
+'output then return a list of the outputs of the statements in
+BODY, if RESULT-TYPE equals 'value then return the value of the
+last statement in BODY."
+  (org-babel-comint-in-buffer buffer
+    (let ((string-buffer "")
+          (full-body (mapconcat #'org-babel-chomp
+                                (list body org-babel-shell-eoe-indicator) "\n"))
+          results)
+      (flet ((my-filt (text) (setq string-buffer (concat string-buffer text))))
+        ;; setup filter
+        (add-hook 'comint-output-filter-functions 'my-filt)
+        ;; pass FULL-BODY to process
+        (goto-char (process-mark (get-buffer-process buffer)))
+        (insert full-body)
+        (comint-send-input)
+        ;; 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 org-babel-shell-eoe-output) nil t)))))
+          (accept-process-output (get-buffer-process buffer)))
+        ;; remove filter
+        (remove-hook 'comint-output-filter-functions 'my-filt))
+      ;; (message (format "raw-results=%S" string-buffer)) ;; debugging
+      ;; (message (format "split-results=%S" (mapcar #'org-babel-trim (split-string string-buffer comint-prompt-regexp)))) ;; debugging
+      ;; split results with `comint-prompt-regexp'
+      (setq results (cdr (member org-babel-shell-eoe-output
+                                 (reverse (mapcar #'org-babel-trim (split-string string-buffer comint-prompt-regexp))))))
+      ;; (message (format "processed-results=%S" results)) ;; debugging
+      (case result-type
+        (output (org-babel-trim (mapconcat #'org-babel-trim (reverse results) "\n")))
+        (value (car results))
+        (t (reverse results))))))
 
 (provide 'org-babel-shell)
 ;;; org-babel-shell.el ends here

org-babel.org

@@ -1,6 +1,6 @@
-#+OPTIONS:    H:3 num:nil toc:t
 #+TITLE: org-babel --- facilitating communication between programming languages and people
-#+SEQ_TODO:  TODO PROPOSED | DONE DEFERRED REJECTED
+#+SEQ_TODO: TODO PROPOSED | DONE DEFERRED REJECTED
+#+OPTIONS: H:3 num:nil toc:t
 #+STARTUP: oddeven hideblocks
 
 * Introduction
@@ -570,13 +570,27 @@ tasking + 2
 #+resname: task-use-new-eval
 : 12
 
-**** TODO Shells [0/5]
-- [ ] functional results working with comint
-- [ ] script results
-- [ ] ensure scalar/vector results args are taken into consideration
-- [ ] ensure callable by other source block
+**** TODO Shells [4/5]
+- [X] functional results working with comint
+- [X] script results
+- [X] ensure scalar/vector results args are taken into consideration
+- [X] ensure callable by other source block
 - [ ] rename buffer after session
 
+#+srcname: task-shell-new-evaluation
+#+begin_src sh :results silent value scalar
+echo 'eric'
+date
+#+end_src
+
+#+srcname: task-call-other-shell
+#+begin_src sh :var other=task-shell-new-evaluation() :results replace  scalar
+echo $other ' is the old date'
+#+end_src
+
+#+resname: task-call-other-shell
+: $ Fri Jun 12 13:08:37 PDT 2009  is the old date
+
 *** TODO implement a *session* header argument
 
 use this header argument to override the default *session* buffer