Merge branch 'maint'
[org-mode/org-kjn.git] / lisp / ob-shell.el
blobaa14a6995584a9730d3c52b897983fe274add014
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
179 (shell session)
180 ;; Needed for Emacs 23 since the marker is initially
181 ;; undefined and the filter functions try to use it without
182 ;; checking.
183 (set-marker comint-last-output-start (point))
184 (get-buffer (current-buffer)))))))
186 (defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
187 "String to indicate that evaluation has completed.")
188 (defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
189 "String to indicate that evaluation has completed.")
191 (defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
192 "Pass BODY to the Shell process in BUFFER.
193 If RESULT-TYPE equals 'output then return a list of the outputs
194 of the statements in BODY, if RESULT-TYPE equals 'value then
195 return the value of the last statement in BODY."
196 (let ((results
197 (cond
198 ((or stdin cmdline) ; external shell script w/STDIN
199 (let ((script-file (org-babel-temp-file "sh-script-"))
200 (stdin-file (org-babel-temp-file "sh-stdin-"))
201 (shebang (cdr (assoc :shebang params)))
202 (padline (not (string= "no" (cdr (assoc :padline params))))))
203 (with-temp-file script-file
204 (when shebang (insert (concat shebang "\n")))
205 (when padline (insert "\n"))
206 (insert body))
207 (set-file-modes script-file #o755)
208 (with-temp-file stdin-file (insert (or stdin "")))
209 (with-temp-buffer
210 (call-process-shell-command
211 (if shebang
212 script-file
213 (format "%s %s" shell-file-name script-file))
214 stdin-file
215 (current-buffer) nil cmdline)
216 (buffer-string))))
217 (session ; session evaluation
218 (mapconcat
219 #'org-babel-sh-strip-weird-long-prompt
220 (mapcar
221 #'org-babel-trim
222 (butlast
223 (org-babel-comint-with-output
224 (session org-babel-sh-eoe-output t body)
225 (mapc
226 (lambda (line)
227 (insert line)
228 (comint-send-input nil t)
229 (while (save-excursion
230 (goto-char comint-last-input-end)
231 (not (re-search-forward
232 comint-prompt-regexp nil t)))
233 (accept-process-output
234 (get-buffer-process (current-buffer)))))
235 (append
236 (split-string (org-babel-trim body) "\n")
237 (list org-babel-sh-eoe-indicator))))
238 2)) "\n"))
239 ('otherwise ; external shell script
240 (if (and (cdr (assoc :shebang params))
241 (> (length (cdr (assoc :shebang params))) 0))
242 (let ((script-file (org-babel-temp-file "sh-script-"))
243 (shebang (cdr (assoc :shebang params)))
244 (padline (not (equal "no" (cdr (assoc :padline params))))))
245 (with-temp-file script-file
246 (when shebang (insert (concat shebang "\n")))
247 (when padline (insert "\n"))
248 (insert body))
249 (set-file-modes script-file #o755)
250 (org-babel-eval script-file ""))
251 (org-babel-eval shell-file-name (org-babel-trim body)))))))
252 (when results
253 (let ((result-params (cdr (assoc :result-params params))))
254 (org-babel-result-cond result-params
255 results
256 (let ((tmp-file (org-babel-temp-file "sh-")))
257 (with-temp-file tmp-file (insert results))
258 (org-babel-import-elisp-from-file tmp-file)))))))
260 (defun org-babel-sh-strip-weird-long-prompt (string)
261 "Remove prompt cruft from a string of shell output."
262 (while (string-match "^% +[\r\n$]+ *" string)
263 (setq string (substring string (match-end 0))))
264 string)
266 (provide 'ob-shell)
270 ;;; ob-shell.el ends here