Merge branch 'maint'
[org-mode.git] / lisp / ob-shell.el
blob8c58dfdcf574a4c2fb2bc1929cf7b958f5909e1d
1 ;;; ob-shell.el --- org-babel functions for shell evaluation
3 ;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
5 ;; Author: Eric Schulte
6 ;; Keywords: literate programming, reproducible research
7 ;; Homepage: http://orgmode.org
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; Org-Babel support for evaluating shell source code.
28 ;;; Code:
29 (require 'ob)
30 (require 'shell)
31 (eval-when-compile (require 'cl))
33 (declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
34 (declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
35 (declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
36 (declare-function org-babel-comint-with-output "ob-comint" (meta &rest body))
37 (declare-function orgtbl-to-generic "org-table" (table params))
39 (defvar org-babel-default-header-args:sh '())
41 (defcustom org-babel-shell-names
42 '("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh")
43 "List of names of shell supported by babel shell code blocks."
44 :group 'org-babel
45 :type 'string
46 :initialize
47 (lambda (symbol value)
48 (set-default symbol (second value))
49 (mapc
50 (lambda (name)
51 (eval `(defun ,(intern (concat "org-babel-execute:" name)) (body params)
52 ,(format "Execute a block of %s commands with Babel." name)
53 (let ((shell-file-name ,name))
54 (org-babel-execute:shell body params)))))
55 (second value))))
57 (defun org-babel-execute:shell (body params)
58 "Execute a block of Shell commands with Babel.
59 This function is called by `org-babel-execute-src-block'."
60 (let* ((session (org-babel-sh-initiate-session
61 (cdr (assoc :session params))))
62 (stdin (let ((stdin (cdr (assoc :stdin params))))
63 (when stdin (org-babel-sh-var-to-string
64 (org-babel-ref-resolve stdin)))))
65 (cmdline (cdr (assoc :cmdline params)))
66 (full-body (org-babel-expand-body:generic
67 body params (org-babel-variable-assignments:sh params))))
68 (org-babel-reassemble-table
69 (org-babel-sh-evaluate session full-body params stdin cmdline)
70 (org-babel-pick-name
71 (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
72 (org-babel-pick-name
73 (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
75 (defun org-babel-prep-session:sh (session params)
76 "Prepare SESSION according to the header arguments specified in PARAMS."
77 (let* ((session (org-babel-sh-initiate-session session))
78 (var-lines (org-babel-variable-assignments:sh params)))
79 (org-babel-comint-in-buffer session
80 (mapc (lambda (var)
81 (insert var) (comint-send-input nil t)
82 (org-babel-comint-wait-for-output session)) var-lines))
83 session))
85 (defun org-babel-load-session:sh (session body params)
86 "Load BODY into SESSION."
87 (save-window-excursion
88 (let ((buffer (org-babel-prep-session:sh session params)))
89 (with-current-buffer buffer
90 (goto-char (process-mark (get-buffer-process (current-buffer))))
91 (insert (org-babel-chomp body)))
92 buffer)))
94 ;; helper functions
95 (defun org-babel-variable-assignments:sh-generic
96 (varname values &optional sep hline)
97 "Returns a list of statements declaring the values as a generic variable."
98 (format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline)))
100 (defun org-babel-variable-assignments:bash_array
101 (varname values &optional sep hline)
102 "Returns a list of statements declaring the values as a bash array."
103 (format "unset %s\ndeclare -a %s=( %s )"
104 varname varname
105 (mapconcat
106 (lambda (value) (org-babel-sh-var-to-sh value sep hline))
107 values
108 " ")))
110 (defun org-babel-variable-assignments:bash_assoc
111 (varname values &optional sep hline)
112 "Returns a list of statements declaring the values as bash associative array."
113 (format "unset %s\ndeclare -A %s\n%s"
114 varname varname
115 (mapconcat
116 (lambda (items)
117 (format "%s[%s]=%s"
118 varname
119 (org-babel-sh-var-to-sh (car items) sep hline)
120 (org-babel-sh-var-to-sh (cdr items) sep hline)))
121 values
122 "\n")))
124 (defun org-babel-variable-assignments:bash (varname values &optional sep hline)
125 "Represents the parameters as useful Bash shell variables."
126 (if (listp values)
127 (if (and (listp (car values)) (= 1 (length (car values))))
128 (org-babel-variable-assignments:bash_array varname values sep hline)
129 (org-babel-variable-assignments:bash_assoc varname values sep hline))
130 (org-babel-variable-assignments:sh-generic varname values sep hline)))
132 (defun org-babel-variable-assignments:sh (params)
133 "Return list of shell statements assigning the block's variables."
134 (let ((sep (cdr (assoc :separator params)))
135 (hline (when (string= "yes" (cdr (assoc :hlines params)))
136 (or (cdr (assoc :hline-string params))
137 "hline"))))
138 (mapcar
139 (lambda (pair)
140 (if (string-match "bash$" shell-file-name)
141 (org-babel-variable-assignments:bash
142 (car pair) (cdr pair) sep hline)
143 (org-babel-variable-assignments:sh-generic
144 (car pair) (cdr pair) sep hline)))
145 (mapcar #'cdr (org-babel-get-header params :var)))))
147 (defun org-babel-sh-var-to-sh (var &optional sep hline)
148 "Convert an elisp value to a shell variable.
149 Convert an elisp var into a string of shell commands specifying a
150 var of the same value."
151 (concat "'" (replace-regexp-in-string
152 "'" "'\"'\"'"
153 (org-babel-sh-var-to-string var sep hline))
154 "'"))
156 (defun org-babel-sh-var-to-string (var &optional sep hline)
157 "Convert an elisp value to a string."
158 (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
159 (cond
160 ((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
161 (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var
162 :hline hline)))
163 ((listp var)
164 (mapconcat echo-var var "\n"))
165 (t (funcall echo-var var)))))
167 (defun org-babel-sh-table-or-results (results)
168 "Convert RESULTS to an appropriate elisp value.
169 If the results look like a table, then convert them into an
170 Emacs-lisp table, otherwise return the results as a string."
171 (org-babel-script-escape results))
173 (defun org-babel-sh-initiate-session (&optional session params)
174 "Initiate a session named SESSION according to PARAMS."
175 (when (and session (not (string= session "none")))
176 (save-window-excursion
177 (or (org-babel-comint-buffer-livep session)
178 (progn (shell session) (get-buffer (current-buffer)))))))
180 (defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
181 "String to indicate that evaluation has completed.")
182 (defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
183 "String to indicate that evaluation has completed.")
185 (defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
186 "Pass BODY to the Shell process in BUFFER.
187 If RESULT-TYPE equals 'output then return a list of the outputs
188 of the statements in BODY, if RESULT-TYPE equals 'value then
189 return the value of the last statement in BODY."
190 (let ((results
191 (cond
192 ((or stdin cmdline) ; external shell script w/STDIN
193 (let ((script-file (org-babel-temp-file "sh-script-"))
194 (stdin-file (org-babel-temp-file "sh-stdin-"))
195 (shebang (cdr (assoc :shebang params)))
196 (padline (not (string= "no" (cdr (assoc :padline params))))))
197 (with-temp-file script-file
198 (when shebang (insert (concat shebang "\n")))
199 (when padline (insert "\n"))
200 (insert body))
201 (set-file-modes script-file #o755)
202 (with-temp-file stdin-file (insert (or stdin "")))
203 (with-temp-buffer
204 (call-process-shell-command
205 (if shebang
206 script-file
207 (format "%s %s" shell-file-name script-file))
208 stdin-file
209 (current-buffer) nil cmdline)
210 (buffer-string))))
211 (session ; session evaluation
212 (mapconcat
213 #'org-babel-sh-strip-weird-long-prompt
214 (mapcar
215 #'org-babel-trim
216 (butlast
217 (org-babel-comint-with-output
218 (session org-babel-sh-eoe-output t body)
219 (mapc
220 (lambda (line)
221 (insert line)
222 (comint-send-input nil t)
223 (while (save-excursion
224 (goto-char comint-last-input-end)
225 (not (re-search-forward
226 comint-prompt-regexp nil t)))
227 (accept-process-output
228 (get-buffer-process (current-buffer)))))
229 (append
230 (split-string (org-babel-trim body) "\n")
231 (list org-babel-sh-eoe-indicator))))
232 2)) "\n"))
233 ('otherwise ; external shell script
234 (if (and (cdr (assoc :shebang params))
235 (> (length (cdr (assoc :shebang params))) 0))
236 (let ((script-file (org-babel-temp-file "sh-script-"))
237 (shebang (cdr (assoc :shebang params)))
238 (padline (not (equal "no" (cdr (assoc :padline params))))))
239 (with-temp-file script-file
240 (when shebang (insert (concat shebang "\n")))
241 (when padline (insert "\n"))
242 (insert body))
243 (set-file-modes script-file #o755)
244 (org-babel-eval script-file ""))
245 (org-babel-eval shell-file-name (org-babel-trim body)))))))
246 (when results
247 (let ((result-params (cdr (assoc :result-params params))))
248 (org-babel-result-cond result-params
249 results
250 (let ((tmp-file (org-babel-temp-file "sh-")))
251 (with-temp-file tmp-file (insert results))
252 (org-babel-import-elisp-from-file tmp-file)))))))
254 (defun org-babel-sh-strip-weird-long-prompt (string)
255 "Remove prompt cruft from a string of shell output."
256 (while (string-match "^% +[\r\n$]+ *" string)
257 (setq string (substring string (match-end 0))))
258 string)
260 (provide 'ob-shell)
264 ;;; ob-shell.el ends here