lisp/ob-sh.el

   1 ;;; ob-sh.el --- org-babel functions for shell evaluation
   2
   3 ;; Copyright (C) 2009, 2010  Free Software Foundation, Inc.
   4
   5 ;; Author: Eric Schulte
   6 ;; Keywords: literate programming, reproducible research
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 0.01
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Org-Babel support for evaluating shell source code.
  28
  29 ;;; Code:
  30 (require 'ob)
  31 (require 'ob-comint)
  32 (require 'ob-eval)
  33 (require 'shell)
  34 (eval-when-compile (require 'cl))
  35
  36 (declare-function org-babel-ref-variables "ob-ref" (params))
  37 (declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
  38 (declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
  39 (declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
  40 (declare-function org-babel-comint-with-output "ob-comint" (meta &rest body))
  41 (declare-function orgtbl-to-generic "org-table" (table params))
  42
  43 (defvar org-babel-default-header-args:sh '())
  44
  45 (defvar org-babel-sh-command "sh"
  46   "Command used to invoke a shell.  This will be passed to
  47   `shell-command-on-region'")
  48
  49 (defun org-babel-expand-body:sh (body params &optional processed-params)
  50   "Expand BODY according to PARAMS, return the expanded body."
  51   (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))
  52         (sep (cdr (assoc :separator params))))
  53     (concat
  54    (mapconcat ;; define any variables
  55     (lambda (pair)
  56       (format "%s=%s"
  57               (car pair)
  58               (org-babel-sh-var-to-sh (cdr pair) sep)))
  59     vars "\n") "\n" body "\n\n")))
  60
  61 (defun org-babel-execute:sh (body params)
  62   "Execute a block of Shell commands with org-babel.  This
  63 function is called by `org-babel-execute-src-block'."
  64   (message "executing Shell source code block")
  65   (let* ((processed-params (org-babel-process-params params))
  66          (session (org-babel-sh-initiate-session (nth 0 processed-params)))
  67          (result-params (nth 2 processed-params))
  68          (full-body (org-babel-expand-body:sh
  69                      body params processed-params)))
  70     (org-babel-reassemble-table
  71      (org-babel-sh-evaluate session full-body result-params)
  72      (org-babel-pick-name
  73       (nth 4 processed-params) (cdr (assoc :colnames params)))
  74      (org-babel-pick-name
  75       (nth 5 processed-params) (cdr (assoc :rownames params))))))
  76
  77 (defun org-babel-prep-session:sh (session params)
  78   "Prepare SESSION according to the header arguments specified in PARAMS."
  79   (let* ((session (org-babel-sh-initiate-session session))
  80          (vars (org-babel-ref-variables params))
  81          (sep (cdr (assoc :separator params)))
  82          (var-lines (mapcar ;; define any variables
  83                      (lambda (pair)
  84                        (format "%s=%s"
  85                                (car pair)
  86                                (org-babel-sh-var-to-sh (cdr pair) sep)))
  87                      vars)))
  88     (org-babel-comint-in-buffer session
  89       (mapc (lambda (var)
  90               (insert var) (comint-send-input nil t)
  91               (org-babel-comint-wait-for-output session)) var-lines))
  92     session))
  93
  94 (defun org-babel-load-session:sh (session body params)
  95   "Load BODY into SESSION."
  96   (save-window-excursion
  97     (let ((buffer (org-babel-prep-session:sh session params)))
  98       (with-current-buffer buffer
  99         (goto-char (process-mark (get-buffer-process (current-buffer))))
 100         (insert (org-babel-chomp body)))
 101       buffer)))
 102
 103 ;; helper functions
 104
 105 (defun org-babel-sh-var-to-sh (var &optional sep)
 106   "Convert an elisp var into a string of shell commands
 107 specifying a var of the same value."
 108   (if (listp var)
 109       (flet ((deep-string (el)
 110                           (if (listp el)
 111                               (mapcar #'deep-string el)
 112                             (org-babel-sh-var-to-sh el sep))))
 113         (format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)"
 114                 (orgtbl-to-generic
 115                  (deep-string var) (list :sep (or sep "\t")))))
 116     (if (stringp var) (format "%s" var) (format "%S" var))))
 117
 118 (defun org-babel-sh-table-or-results (results)
 119   "If the results look like a table, then convert them into an
 120 Emacs-lisp table, otherwise return the results as a string."
 121   (org-babel-read
 122    (if (string-match "^\\[.+\\]$" results)
 123        (org-babel-read
 124         (concat "'"
 125                 (replace-regexp-in-string
 126                  "\\[" "(" (replace-regexp-in-string
 127                             "\\]" ")" (replace-regexp-in-string
 128                                        ", " " " (replace-regexp-in-string
 129                                                  "'" "\"" results))))))
 130      results)))
 131
 132 (defun org-babel-sh-initiate-session (&optional session params)
 133   "Initiate a session named SESSION according to PARAMS."
 134   (when (and session (not (string= session "none")))
 135     (save-window-excursion
 136       (or (org-babel-comint-buffer-livep session)
 137           (progn (shell session) (get-buffer (current-buffer)))))))
 138
 139 (defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
 140   "Used to indicate that evaluation is has completed.")
 141 (defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
 142   "Used to indicate that evaluation is has completed.")
 143
 144 (defun org-babel-sh-evaluate (session body &optional result-params)
 145   "Pass BODY to the Shell process in BUFFER.  If RESULT-TYPE equals
 146 'output then return a list of the outputs of the statements in
 147 BODY, if RESULT-TYPE equals 'value then return the value of the
 148 last statement in BODY."
 149   ((lambda (results)
 150      (if (or (member "scalar" result-params)
 151              (member "output" result-params))
 152          results
 153        (let ((tmp-file (make-temp-file "org-babel-sh")))
 154          (with-temp-file tmp-file (insert results))
 155          (org-babel-import-elisp-from-file tmp-file))))
 156    (if (not session)
 157        (org-babel-eval org-babel-sh-command (org-babel-trim body))
 158      (let ((tmp-file (make-temp-file "org-babel-sh")))
 159        (mapconcat
 160         #'org-babel-sh-strip-weird-long-prompt
 161         (mapcar
 162          #'org-babel-trim
 163          (butlast
 164           (org-babel-comint-with-output
 165               (session org-babel-sh-eoe-output t body)
 166             (mapc
 167              (lambda (line)
 168                (insert line) (comint-send-input nil t) (sleep-for 0.25))
 169              (append
 170               (split-string (org-babel-trim body) "\n")
 171               (list org-babel-sh-eoe-indicator))))
 172           2)) "\n")))))
 173
 174 (defun org-babel-sh-strip-weird-long-prompt (string)
 175   "Remove prompt cruft from a string of shell output."
 176   (while (string-match "^% +[\r\n$]+ *" string)
 177     (setq string (substring string (match-end 0))))
 178   string)
 179
 180 (provide 'ob-sh)
 181
 182 ;; arch-tag: 416dd531-c230-4b0a-a5bf-8d948f990f2d
 183
 184 ;;; ob-sh.el ends here