HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Better seed support for (random).
[bpt/emacs.git] / lisp / org / ob.el
CommitLineData
86fbb8ca
CD		 1;;; ob.el --- working with code blocks in org-mode
2
b73f1974 3;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
86fbb8ca 4
dfd98937 5;; Authors: Eric Schulte
c7557a0f 6;; Dan Davison
86fbb8ca
CD		 7;; Keywords: literate programming, reproducible research
8;; Homepage: http://orgmode.org
86fbb8ca
CD		 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
86fbb8ca 25;;; Code:
eeb4145e 26(eval-when-compile
e720ae53 27 (require 'cl))
acedf35c 28(require 'ob-eval)
86fbb8ca
CD		 29(require 'org-macs)
30
31(defvar org-babel-call-process-region-original)
3ab2c837
BG		 32(defvar org-src-lang-modes)
33(defvar org-babel-library-of-babel)
86fbb8ca 34(declare-function show-all "outline" ())
e66ba1df 35(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
f1eee0b6
GM		 36(declare-function tramp-compat-make-temp-file "tramp-compat"
37 (filename &optional dir-flag))
86fbb8ca
CD		 38(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
39(declare-function tramp-file-name-user "tramp" (vec))
40(declare-function tramp-file-name-host "tramp" (vec))
afe98dfa 41(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
86fbb8ca 42(declare-function org-icompleting-read "org" (&rest args))
acedf35c 43(declare-function org-edit-src-code "org-src"
afe98dfa
CD		 44 (&optional context code edit-buffer-name quietp))
45(declare-function org-edit-src-exit "org-src" (&optional context))
86fbb8ca 46(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
afe98dfa
CD		 47(declare-function org-save-outline-visibility "org" (use-markers &rest body))
48(declare-function org-outline-overlay-data "org" (&optional use-markers))
49(declare-function org-set-outline-overlay-data "org" (data))
86fbb8ca 50(declare-function org-narrow-to-subtree "org" ())
afe98dfa
CD		 51(declare-function org-entry-get "org"
52 (pom property &optional inherit literal-nil))
86fbb8ca 53(declare-function org-make-options-regexp "org" (kwds &optional extra))
86fbb8ca
CD		 54(declare-function org-do-remove-indentation "org" (&optional n))
55(declare-function org-show-context "org" (&optional key))
56(declare-function org-at-table-p "org" (&optional table-type))
57(declare-function org-cycle "org" (&optional arg))
58(declare-function org-uniquify "org" (list))
afe98dfa 59(declare-function org-current-level "org" ())
f1eee0b6 60(declare-function org-table-import "org-table" (file arg))
afe98dfa
CD		 61(declare-function org-add-hook "org-compat"
62 (hook function &optional append local))
86fbb8ca
CD		 63(declare-function org-table-align "org-table" ())
64(declare-function org-table-end "org-table" (&optional table-type))
65(declare-function orgtbl-to-generic "org-table" (table params))
66(declare-function orgtbl-to-orgtbl "org-table" (table params))
3ab2c837 67(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
86fbb8ca
CD		 68(declare-function org-babel-lob-get-info "ob-lob" nil)
69(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
afe98dfa
CD		 70(declare-function org-babel-ref-parse "ob-ref" (assignment))
71(declare-function org-babel-ref-resolve "ob-ref" (ref))
3ab2c837
BG		 72(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
73(declare-function org-babel-ref-headline-body "ob-ref" ())
afe98dfa
CD		 74(declare-function org-babel-lob-execute-maybe "ob-lob" ())
75(declare-function org-number-sequence "org-compat" (from &optional to inc))
3ab2c837 76(declare-function org-at-item-p "org-list" ())
acedf35c
CD		 77(declare-function org-list-parse-list "org-list" (&optional delete))
78(declare-function org-list-to-generic "org-list" (LIST PARAMS))
3ab2c837
BG		 79(declare-function org-list-struct "org-list" ())
80(declare-function org-list-prevs-alist "org-list" (struct))
81(declare-function org-list-get-list-end "org-list" (item struct prevs))
153ae947 82(declare-function org-strip-protective-commas "org" (beg end))
86fbb8ca
CD		 83
84(defgroup org-babel nil
85 "Code block evaluation and management in `org-mode' documents."
86 :tag "Babel"
87 :group 'org)
88
89(defcustom org-confirm-babel-evaluate t
90 "Confirm before evaluation.
91Require confirmation before interactively evaluating code
92blocks in Org-mode buffers. The default value of this variable
93is t, meaning confirmation is required for any code block
94evaluation. This variable can be set to nil to inhibit any
95future confirmation requests. This variable can also be set to a
96function which takes two arguments the language of the code block
97and the body of the code block. Such a function should then
98return a non-nil value if the user should be prompted for
99execution or nil if no prompt is required.
100
101Warning: Disabling confirmation may result in accidental
102evaluation of potentially harmful code. It may be advisable
103remove code block execution from C-c C-c as further protection
104against accidental code block evaluation. The
105`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
106remove code block execution from the C-c C-c keybinding."
107 :group 'org-babel
372d7b21 108 :version "24.1"
86fbb8ca
CD		 109 :type '(choice boolean function))
110;; don't allow this variable to be changed through file settings
111(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
112
113(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
114 "Remove code block evaluation from the C-c C-c key binding."
115 :group 'org-babel
372d7b21 116 :version "24.1"
86fbb8ca
CD		 117 :type 'boolean)
118
153ae947
BG		 119(defcustom org-babel-results-keyword "RESULTS"
120 "Keyword used to name results generated by code blocks.
121Should be either RESULTS or NAME however any capitalization may
122be used."
123 :group 'org-babel
124 :type 'string)
125
86fbb8ca 126(defvar org-babel-src-name-regexp
e66ba1df 127 "^[ \t]*#\\+name:[ \t]*"
86fbb8ca
CD		 128 "Regular expression used to match a source name line.")
129
afe98dfa
CD		 130(defvar org-babel-multi-line-header-regexp
131 "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
132 "Regular expression used to match multi-line header arguments.")
133
86fbb8ca
CD		 134(defvar org-babel-src-name-w-name-regexp
135 (concat org-babel-src-name-regexp
afe98dfa
CD		 136 "\\("
137 org-babel-multi-line-header-regexp
138 "\\)*"
86fbb8ca
CD		 139 "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
140 "Regular expression matching source name lines with a name.")
141
142(defvar org-babel-src-block-regexp
143 (concat
3ab2c837 144 ;; (1) indentation (2) lang
86fbb8ca
CD		 145 "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*"
146 ;; (3) switches
147 "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)"
148 ;; (4) header arguments
149 "\\([^\n]*\\)\n"
150 ;; (5) body
9a70f03d 151 "\\([^\000]*?\n\\)?[ \t]*#\\+end_src")
86fbb8ca
CD		 152 "Regexp used to identify code blocks.")
153
154(defvar org-babel-inline-src-block-regexp
155 (concat
156 ;; (1) replacement target (2) lang
e66ba1df 157 "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)"
86fbb8ca
CD		 158 ;; (3,4) (unused, headers)
159 "\\(\\|\\[\\(.*?\\)\\]\\)"
160 ;; (5) body
161 "{\\([^\f\n\r\v]+?\\)}\\)")
162 "Regexp used to identify inline src-blocks.")
163
afe98dfa
CD		 164(defun org-babel-get-header (params key &optional others)
165 "Select only header argument of type KEY from a list.
166Optional argument OTHERS indicates that only the header that do
167not match KEY should be returned."
168 (delq nil
169 (mapcar
170 (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
171 params)))
172
e66ba1df
BG		 173(defun org-babel-get-inline-src-block-matches()
174 "Set match data if within body of an inline source block.
175Returns non-nil if match-data set"
176 (let ((src-at-0-p (save-excursion
177 (beginning-of-line 1)
178 (string= "src" (thing-at-point 'word))))
179 (first-line-p (= 1 (line-number-at-pos)))
180 (orig (point)))
181 (let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
153ae947
BG		 182 (first-line-p "[[:punct:] \t]src_")
183 (t "[[:punct:] \f\t\n\r\v]src_")))
e66ba1df
BG		 184 (lower-limit (if first-line-p
185 nil
186 (- (point-at-bol) 1))))
187 (save-excursion
188 (when (or (and src-at-0-p (bobp))
189 (and (re-search-forward "}" (point-at-eol) t)
190 (re-search-backward search-for lower-limit t)
191 (> orig (point))))
192 (when (looking-at org-babel-inline-src-block-regexp)
193 t ))))))
194
195(defvar org-babel-inline-lob-one-liner-regexp)
196(defun org-babel-get-lob-one-liner-matches()
197 "Set match data if on line of an lob one liner.
198Returns non-nil if match-data set"
199 (save-excursion
200 (unless (= (point) (point-at-bol)) ;; move before inline block
201 (re-search-backward "[ \f\t\n\r\v]" nil t))
202 (if (looking-at org-babel-inline-lob-one-liner-regexp)
203 t
204 nil)))
205
afe98dfa 206(defun org-babel-get-src-block-info (&optional light)
86fbb8ca
CD		 207 "Get information on the current source block.
208
afe98dfa
CD		 209Optional argument LIGHT does not resolve remote variable
210references; a process which could likely result in the execution
211of other code blocks.
212
86fbb8ca 213Returns a list
afe98dfa
CD		 214 (language body header-arguments-alist switches name indent)."
215 (let ((case-fold-search t) head info name indent)
216 ;; full code block
86fbb8ca 217 (if (setq head (org-babel-where-is-src-block-head))
afe98dfa 218 (save-excursion
86fbb8ca
CD		 219 (goto-char head)
220 (setq info (org-babel-parse-src-block-match))
221 (setq indent (car (last info)))
222 (setq info (butlast info))
afe98dfa
CD		 223 (while (and (forward-line -1)
224 (looking-at org-babel-multi-line-header-regexp))
225 (setf (nth 2 info)
226 (org-babel-merge-params
3ab2c837
BG		 227 (nth 2 info)
228 (org-babel-parse-header-arguments (match-string 1)))))
afe98dfa 229 (when (looking-at org-babel-src-name-w-name-regexp)
e66ba1df
BG		 230 (setq name (org-babel-clean-text-properties (match-string 3)))
231 (when (and (match-string 5) (> (length (match-string 5)) 0))
afe98dfa
CD		 232 (setf (nth 2 info) ;; merge functional-syntax vars and header-args
233 (org-babel-merge-params
e66ba1df
BG		 234 (mapcar
235 (lambda (ref) (cons :var ref))
236 (mapcar
237 (lambda (var) ;; check that each variable is initialized
238 (if (string-match ".+=.+" var)
239 var
240 (error
241 "variable \"%s\"%s must be assigned a default value"
242 var (if name (format " in block \"%s\"" name) ""))))
243 (org-babel-ref-split-args (match-string 5))))
afe98dfa
CD		 244 (nth 2 info))))))
245 ;; inline source block
e66ba1df 246 (when (org-babel-get-inline-src-block-matches)
afe98dfa
CD		 247 (setq info (org-babel-parse-inline-src-block-match))))
248 ;; resolve variable references and add summary parameters
249 (when (and info (not light))
250 (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
251 (when info (append info (list name indent)))))
86fbb8ca 252
e66ba1df 253(defvar org-current-export-file) ; dynamically bound
86fbb8ca
CD		 254(defun org-babel-confirm-evaluate (info)
255 "Confirm evaluation of the code block INFO.
256This behavior can be suppressed by setting the value of
257`org-confirm-babel-evaluate' to nil, in which case all future
258interactive code block evaluations will proceed without any
259confirmation from the user.
260
261Note disabling confirmation may result in accidental evaluation
262of potentially harmful code."
afe98dfa
CD		 263 (let* ((eval (or (cdr (assoc :eval (nth 2 info)))
264 (when (assoc :noeval (nth 2 info)) "no")))
3ab2c837 265 (query (cond ((equal eval "query") t)
e66ba1df
BG		 266 ((and org-current-export-file
267 (equal eval "query-export")) t)
3ab2c837
BG		 268 ((functionp org-confirm-babel-evaluate)
269 (funcall org-confirm-babel-evaluate
270 (nth 0 info) (nth 1 info)))
271 (t org-confirm-babel-evaluate))))
afe98dfa 272 (if (or (equal eval "never") (equal eval "no")
e66ba1df
BG		 273 (and org-current-export-file (or (equal eval "no-export")
274 (equal eval "never-export")))
afe98dfa
CD		 275 (and query
276 (not (yes-or-no-p
acedf35c
CD		 277 (format "Evaluate this%scode block%son your system? "
278 (if info (format " %s " (nth 0 info)) " ")
279 (if (nth 4 info)
280 (format " (%s) " (nth 4 info)) " "))))))
281 (prog1 nil (message "Evaluation %s"
e66ba1df
BG		 282 (if (or (equal eval "never") (equal eval "no")
283 (equal eval "no-export")
284 (equal eval "never-export"))
acedf35c 285 "Disabled" "Aborted")))
afe98dfa 286 t)))
86fbb8ca
CD		 287
288;;;###autoload
afe98dfa
CD		 289(defun org-babel-execute-safely-maybe ()
290 (unless org-babel-no-eval-on-ctrl-c-ctrl-c
291 (org-babel-execute-maybe)))
292
293(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe)
294
295;;;###autoload
296(defun org-babel-execute-maybe ()
297 (interactive)
298 (or (org-babel-execute-src-block-maybe)
299 (org-babel-lob-execute-maybe)))
300
86fbb8ca
CD		 301(defun org-babel-execute-src-block-maybe ()
302 "Conditionally execute a source block.
303Detect if this is context for a Babel src-block and if so
304then run `org-babel-execute-src-block'."
305 (interactive)
afe98dfa
CD		 306 (let ((info (org-babel-get-src-block-info)))
307 (if info
acedf35c
CD		 308 (progn (org-babel-eval-wipe-error-buffer)
309 (org-babel-execute-src-block current-prefix-arg info) t) nil)))
86fbb8ca 310
3ab2c837
BG		 311;;;###autoload
312(defun org-babel-view-src-block-info ()
313 "Display information on the current source block.
314This includes header arguments, language and name, and is largely
315a window into the `org-babel-get-src-block-info' function."
316 (interactive)
317 (let ((info (org-babel-get-src-block-info 'light)))
318 (flet ((full (it) (> (length it) 0))
319 (printf (fmt &rest args) (princ (apply #'format fmt args))))
320 (when info
321 (with-help-window (help-buffer)
322 (let ((name (nth 4 info))
323 (lang (nth 0 info))
324 (switches (nth 3 info))
325 (header-args (nth 2 info)))
326 (when name (printf "Name: %s\n" name))
327 (when lang (printf "Lang: %s\n" lang))
328 (when (full switches) (printf "Switches: %s\n" switches))
329 (printf "Header Arguments:\n")
330 (dolist (pair (sort header-args
331 (lambda (a b) (string< (symbol-name (car a))
332 (symbol-name (car b))))))
333 (when (full (cdr pair))
334 (printf "\t%S%s\t%s\n"
335 (car pair)
336 (if (> (length (format "%S" (car pair))) 7) "" "\t")
337 (cdr pair))))))))))
338
86fbb8ca
CD		 339;;;###autoload
340(defun org-babel-expand-src-block-maybe ()
341 "Conditionally expand a source block.
342Detect if this is context for a org-babel src-block and if so
343then run `org-babel-expand-src-block'."
344 (interactive)
345 (let ((info (org-babel-get-src-block-info)))
346 (if info
347 (progn (org-babel-expand-src-block current-prefix-arg info) t)
348 nil)))
349
350;;;###autoload
351(defun org-babel-load-in-session-maybe ()
352 "Conditionally load a source block in a session.
353Detect if this is context for a org-babel src-block and if so
354then run `org-babel-load-in-session'."
355 (interactive)
356 (let ((info (org-babel-get-src-block-info)))
357 (if info
358 (progn (org-babel-load-in-session current-prefix-arg info) t)
359 nil)))
360
361(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
362
363;;;###autoload
364(defun org-babel-pop-to-session-maybe ()
365 "Conditionally pop to a session.
366Detect if this is context for a org-babel src-block and if so
367then run `org-babel-pop-to-session'."
368 (interactive)
369 (let ((info (org-babel-get-src-block-info)))
370 (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
371
372(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
373
e66ba1df
BG		 374(defconst org-babel-common-header-args-w-values
375 '((cache . ((no yes)))
376 (cmdline . :any)
377 (colnames . ((nil no yes)))
378 (comments . ((no link yes org both noweb)))
379 (dir . :any)
380 (eval . ((never query)))
381 (exports . ((code results both none)))
382 (file . :any)
383 (hlines . ((no yes)))
384 (mkdirp . ((yes no)))
385 (no-expand)
386 (noeval)
387 (noweb . ((yes no tangle)))
388 (noweb-ref . :any)
153ae947 389 (noweb-sep . :any)
e66ba1df
BG		 390 (padline . ((yes no)))
391 (results . ((file list vector table scalar verbatim)
392 (raw org html latex code pp wrap)
393 (replace silent append prepend)
394 (output value)))
395 (rownames . ((no yes)))
396 (sep . :any)
397 (session . :any)
398 (shebang . :any)
399 (tangle . ((tangle yes no :any)))
400 (var . :any)))
401
86fbb8ca 402(defconst org-babel-header-arg-names
e66ba1df 403 (mapcar #'car org-babel-common-header-args-w-values)
86fbb8ca
CD		 404 "Common header arguments used by org-babel.
405Note that individual languages may define their own language
406specific header arguments as well.")
407
408(defvar org-babel-default-header-args
409 '((:session . "none") (:results . "replace") (:exports . "code")
3ab2c837
BG		 410 (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")
411 (:padnewline . "yes"))
86fbb8ca
CD		 412 "Default arguments to use when evaluating a source block.")
413
414(defvar org-babel-default-inline-header-args
3ab2c837 415 '((:session . "none") (:results . "replace") (:exports . "results"))
86fbb8ca
CD		 416 "Default arguments to use when evaluating an inline source block.")
417
e66ba1df 418(defvar org-babel-data-names '("TBLNAME" "RESULTS" "NAME"))
86fbb8ca
CD		 419
420(defvar org-babel-result-regexp
3ab2c837
BG		 421 (concat "^[ \t]*#\\+"
422 (regexp-opt org-babel-data-names t)
423 "\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*")
86fbb8ca
CD		 424 "Regular expression used to match result lines.
425If the results are associated with a hash key then the hash will
426be saved in the second match data.")
427
428(defvar org-babel-result-w-name-regexp
429 (concat org-babel-result-regexp
430 "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
431
432(defvar org-babel-min-lines-for-block-output 10
433 "The minimum number of lines for block output.
434If number of lines of output is equal to or exceeds this
435value, the output is placed in a #+begin_example...#+end_example
436block. Otherwise the output is marked as literal by inserting
437colons at the starts of the lines. This variable only takes
438effect if the :results output option is in effect.")
439
440(defvar org-babel-noweb-error-langs nil
441 "Languages for which Babel will raise literate programming errors.
442List of languages for which errors should be raised when the
443source code block satisfying a noweb reference in this language
444can not be resolved.")
445
446(defvar org-babel-hash-show 4
447 "Number of initial characters to show of a hidden results hash.")
448
449(defvar org-babel-after-execute-hook nil
450 "Hook for functions to be called after `org-babel-execute-src-block'")
e66ba1df 451
86fbb8ca
CD		 452(defun org-babel-named-src-block-regexp-for-name (name)
453 "This generates a regexp used to match a src block named NAME."
e66ba1df
BG		 454 (concat org-babel-src-name-regexp (regexp-quote name)
455 "\\([ \t]\\|$\\|(\\)" ".*[\r\n]"
86fbb8ca
CD		 456 (substring org-babel-src-block-regexp 1)))
457
e66ba1df
BG		 458(defun org-babel-named-data-regexp-for-name (name)
459 "This generates a regexp used to match data named NAME."
460 (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)"))
461
86fbb8ca
CD		 462;;; functions
463(defvar call-process-region)
464;;;###autoload
afe98dfa 465
86fbb8ca
CD		 466(defun org-babel-execute-src-block (&optional arg info params)
467 "Execute the current source code block.
468Insert the results of execution into the buffer. Source code
469execution and the collection and formatting of results can be
470controlled through a variety of header arguments.
471
e66ba1df
BG		 472With prefix argument ARG, force re-execution even if an existing
473result cached in the buffer would otherwise have been returned.
afe98dfa 474
86fbb8ca
CD		 475Optionally supply a value for INFO in the form returned by
476`org-babel-get-src-block-info'.
477
478Optionally supply a value for PARAMS which will be merged with
479the header arguments specified at the front of the source code
480block."
481 (interactive)
afe98dfa 482 (let ((info (or info (org-babel-get-src-block-info))))
153ae947
BG		 483 (when (org-babel-confirm-evaluate
484 (let ((i info))
485 (setf (nth 2 i) (org-babel-merge-params (nth 2 info) params))
486 i))
afe98dfa
CD		 487 (let* ((lang (nth 0 info))
488 (params (if params
489 (org-babel-process-params
490 (org-babel-merge-params (nth 2 info) params))
491 (nth 2 info)))
492 (cache? (and (not arg) (cdr (assoc :cache params))
493 (string= "yes" (cdr (assoc :cache params)))))
494 (result-params (cdr (assoc :result-params params)))
495 (new-hash (when cache? (org-babel-sha1-hash info)))
3ab2c837 496 (old-hash (when cache? (org-babel-current-result-hash)))
afe98dfa 497 (body (setf (nth 1 info)
acedf35c
CD		 498 (let ((noweb (cdr (assoc :noweb params))))
499 (if (and noweb
500 (or (string= "yes" noweb)
501 (string= "tangle" noweb)))
502 (org-babel-expand-noweb-references info)
503 (nth 1 info)))))
afe98dfa
CD		 504 (dir (cdr (assoc :dir params)))
505 (default-directory
506 (or (and dir (file-name-as-directory dir)) default-directory))
507 (org-babel-call-process-region-original
508 (if (boundp 'org-babel-call-process-region-original)
509 org-babel-call-process-region-original
510 (symbol-function 'call-process-region)))
511 (indent (car (last info)))
3ab2c837 512 result cmd)
afe98dfa
CD		 513 (unwind-protect
514 (flet ((call-process-region (&rest args)
acedf35c 515 (apply 'org-babel-tramp-handle-call-process-region args)))
3ab2c837
BG		 516 (flet ((lang-check (f)
517 (let ((f (intern (concat "org-babel-execute:" f))))
518 (when (fboundp f) f))))
519 (setq cmd
520 (or (lang-check lang)
521 (lang-check (symbol-name
522 (cdr (assoc lang org-src-lang-modes))))
523 (error "No org-babel-execute function for %s!" lang))))
afe98dfa
CD		 524 (if (and (not arg) new-hash (equal new-hash old-hash))
525 (save-excursion ;; return cached result
526 (goto-char (org-babel-where-is-src-block-result nil info))
527 (end-of-line 1) (forward-char 1)
528 (setq result (org-babel-read-result))
529 (message (replace-regexp-in-string
530 "%" "%%" (format "%S" result))) result)
531 (message "executing %s code block%s..."
532 (capitalize lang)
533 (if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
534 (setq result
535 ((lambda (result)
3ab2c837
BG		 536 (if (and (eq (cdr (assoc :result-type params)) 'value)
537 (or (member "vector" result-params)
538 (member "table" result-params))
539 (not (listp result)))
540 (list (list result)) result))
afe98dfa 541 (funcall cmd body params)))
3ab2c837
BG		 542 ;; if non-empty result and :file then write to :file
543 (when (cdr (assoc :file params))
544 (when result
545 (with-temp-file (cdr (assoc :file params))
546 (insert
547 (org-babel-format-result
548 result (cdr (assoc :sep (nth 2 info)))))))
549 (setq result (cdr (assoc :file params))))
afe98dfa
CD		 550 (org-babel-insert-result
551 result result-params info new-hash indent lang)
552 (run-hooks 'org-babel-after-execute-hook)
553 result))
554 (setq call-process-region 'org-babel-call-process-region-original))))))
555
556(defun org-babel-expand-body:generic (body params &optional var-lines)
86fbb8ca 557 "Expand BODY with PARAMS.
a98edce9 558Expand a block of code with org-babel according to its header
86fbb8ca
CD		 559arguments. This generic implementation of body expansion is
560called for languages which have not defined their own specific
afe98dfa
CD		 561org-babel-expand-body:lang function."
562 (mapconcat #'identity (append var-lines (list body)) "\n"))
86fbb8ca
CD		 563
564;;;###autoload
565(defun org-babel-expand-src-block (&optional arg info params)
566 "Expand the current source code block.
567Expand according to the source code block's header
568arguments and pop open the results in a preview buffer."
569 (interactive)
570 (let* ((info (or info (org-babel-get-src-block-info)))
571 (lang (nth 0 info))
572 (params (setf (nth 2 info)
573 (sort (org-babel-merge-params (nth 2 info) params)
574 (lambda (el1 el2) (string< (symbol-name (car el1))
afe98dfa 575 (symbol-name (car el2)))))))
86fbb8ca
CD		 576 (body (setf (nth 1 info)
577 (if (and (cdr (assoc :noweb params))
578 (string= "yes" (cdr (assoc :noweb params))))
579 (org-babel-expand-noweb-references info) (nth 1 info))))
afe98dfa 580 (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
3ab2c837
BG		 581 (assignments-cmd (intern (concat "org-babel-variable-assignments:"
582 lang)))
afe98dfa
CD		 583 (expanded
584 (if (fboundp expand-cmd) (funcall expand-cmd body params)
585 (org-babel-expand-body:generic
3ab2c837
BG		 586 body params (and (fboundp assignments-cmd)
587 (funcall assignments-cmd params))))))
86fbb8ca
CD		 588 (org-edit-src-code
589 nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))))
590
3ab2c837
BG		 591(defun org-babel-edit-distance (s1 s2)
592 "Return the edit (levenshtein) distance between strings S1 S2."
593 (let* ((l1 (length s1))
594 (l2 (length s2))
595 (dist (map 'vector (lambda (_) (make-vector (1+ l2) nil))
596 (number-sequence 1 (1+ l1)))))
597 (flet ((in (i j) (aref (aref dist i) j))
598 (mmin (&rest lst) (apply #'min (remove nil lst))))
599 (setf (aref (aref dist 0) 0) 0)
600 (dolist (i (number-sequence 1 l1))
601 (dolist (j (number-sequence 1 l2))
602 (setf (aref (aref dist i) j)
603 (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
604 (mmin (in (1- i) j) (in i (1- j)) (in (1- i) (1- j)))))))
605 (in l1 l2))))
606
607;;;###autoload
608(defun org-babel-check-src-block ()
609 "Check for misspelled header arguments in the current code block."
610 (interactive)
611 ;; TODO: report malformed code block
612 ;; TODO: report incompatible combinations of header arguments
e66ba1df 613 ;; TODO: report uninitialized variables
153ae947
BG		 614 (let ((too-close 2) ;; <- control closeness to report potential match
615 (names (mapcar #'symbol-name org-babel-header-arg-names)))
3ab2c837
BG		 616 (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
617 (and (org-babel-where-is-src-block-head)
618 (org-babel-parse-header-arguments
619 (org-babel-clean-text-properties
620 (match-string 4))))))
153ae947 621 (dolist (name names)
3ab2c837 622 (when (and (not (string= header name))
153ae947
BG		 623 (<= (org-babel-edit-distance header name) too-close)
624 (not (member header names)))
3ab2c837
BG		 625 (error "supplied header \"%S\" is suspiciously close to \"%S\""
626 header name))))
627 (message "No suspicious header arguments found.")))
628
e66ba1df
BG		 629;;;###autoload
630(defun org-babel-insert-header-arg ()
631 "Insert a header argument selecting from lists of common args and values."
632 (interactive)
633 (let* ((lang (car (org-babel-get-src-block-info 'light)))
634 (lang-headers (intern (concat "org-babel-header-arg-names:" lang)))
635 (headers (append (if (boundp lang-headers)
636 (mapcar (lambda (h) (cons h :any))
637 (eval lang-headers))
638 nil)
639 org-babel-common-header-args-w-values))
640 (arg (org-icompleting-read
641 "Header Arg: "
642 (mapcar
643 (lambda (header-spec) (symbol-name (car header-spec)))
644 headers))))
645 (insert ":" arg)
646 (let ((vals (cdr (assoc (intern arg) headers))))
647 (when vals
648 (insert
649 " "
650 (cond
651 ((eq vals :any)
652 (read-from-minibuffer "value: "))
653 ((listp vals)
654 (mapconcat
655 (lambda (group)
656 (let ((arg (org-icompleting-read
657 "value: "
658 (cons "default" (mapcar #'symbol-name group)))))
659 (if (and arg (not (string= "default" arg)))
660 (concat arg " ")
661 "")))
662 vals ""))))))))
663
86fbb8ca
CD		 664;;;###autoload
665(defun org-babel-load-in-session (&optional arg info)
666 "Load the body of the current source-code block.
667Evaluate the header arguments for the source block before
668entering the session. After loading the body this pops open the
669session."
670 (interactive)
671 (let* ((info (or info (org-babel-get-src-block-info)))
672 (lang (nth 0 info))
86fbb8ca 673 (params (nth 2 info))
afe98dfa
CD		 674 (body (setf (nth 1 info)
675 (if (and (cdr (assoc :noweb params))
676 (string= "yes" (cdr (assoc :noweb params))))
677 (org-babel-expand-noweb-references info)
678 (nth 1 info))))
86fbb8ca 679 (session (cdr (assoc :session params)))
afe98dfa
CD		 680 (dir (cdr (assoc :dir params)))
681 (default-directory
682 (or (and dir (file-name-as-directory dir)) default-directory))
86fbb8ca
CD		 683 (cmd (intern (concat "org-babel-load-session:" lang))))
684 (unless (fboundp cmd)
685 (error "No org-babel-load-session function for %s!" lang))
686 (pop-to-buffer (funcall cmd session body params))
687 (end-of-line 1)))
688
689;;;###autoload
afe98dfa
CD		 690(defun org-babel-initiate-session (&optional arg info)
691 "Initiate session for current code block.
692If called with a prefix argument then resolve any variable
693references in the header arguments and assign these variables in
694the session. Copy the body of the code block to the kill ring."
695 (interactive "P")
696 (let* ((info (or info (org-babel-get-src-block-info (not arg))))
86fbb8ca
CD		 697 (lang (nth 0 info))
698 (body (nth 1 info))
699 (params (nth 2 info))
700 (session (cdr (assoc :session params)))
701 (dir (cdr (assoc :dir params)))
702 (default-directory
703 (or (and dir (file-name-as-directory dir)) default-directory))
afe98dfa
CD		 704 (init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
705 (prep-cmd (intern (concat "org-babel-prep-session:" lang))))
706 (if (and (stringp session) (string= session "none"))
707 (error "This block is not using a session!"))
708 (unless (fboundp init-cmd)
86fbb8ca 709 (error "No org-babel-initiate-session function for %s!" lang))
86fbb8ca
CD		 710 (with-temp-buffer (insert (org-babel-trim body))
711 (copy-region-as-kill (point-min) (point-max)))
afe98dfa
CD		 712 (when arg
713 (unless (fboundp prep-cmd)
714 (error "No org-babel-prep-session function for %s!" lang))
715 (funcall prep-cmd session params))
716 (funcall init-cmd session params)))
717
718;;;###autoload
719(defun org-babel-switch-to-session (&optional arg info)
720 "Switch to the session of the current code block.
721Uses `org-babel-initiate-session' to start the session. If called
722with a prefix argument then this is passed on to
723`org-babel-initiate-session'."
724 (interactive "P")
725 (pop-to-buffer (org-babel-initiate-session arg info))
726 (end-of-line 1))
86fbb8ca
CD		 727
728(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
729
afe98dfa
CD		 730;;;###autoload
731(defun org-babel-switch-to-session-with-code (&optional arg info)
732 "Switch to code buffer and display session."
733 (interactive "P")
734 (flet ((swap-windows
735 ()
736 (let ((other-window-buffer (window-buffer (next-window))))
737 (set-window-buffer (next-window) (current-buffer))
738 (set-window-buffer (selected-window) other-window-buffer))
739 (other-window 1)))
740 (let ((info (org-babel-get-src-block-info))
741 (org-src-window-setup 'reorganize-frame))
742 (save-excursion
743 (org-babel-switch-to-session arg info))
744 (org-edit-src-code))
745 (swap-windows)))
746
747(defmacro org-babel-do-in-edit-buffer (&rest body)
748 "Evaluate BODY in edit buffer if there is a code block at point.
749Return t if a code block was found at point, nil otherwise."
750 `(let ((org-src-window-setup 'switch-invisibly))
751 (when (and (org-babel-where-is-src-block-head)
3ab2c837 752 (org-edit-src-code nil nil nil))
afe98dfa
CD		 753 (unwind-protect (progn ,@body)
754 (if (org-bound-and-true-p org-edit-src-from-org-mode)
755 (org-edit-src-exit)))
756 t)))
e66ba1df 757(def-edebug-spec org-babel-do-in-edit-buffer (body))
afe98dfa
CD		 758
759(defun org-babel-do-key-sequence-in-edit-buffer (key)
760 "Read key sequence and execute the command in edit buffer.
761Enter a key sequence to be executed in the language major-mode
762edit buffer. For example, TAB will alter the contents of the
763Org-mode code block according to the effect of TAB in the
764language major-mode buffer. For languages that support
765interactive sessions, this can be used to send code from the Org
766buffer to the session for evaluation using the native major-mode
767evaluation mechanisms."
768 (interactive "kEnter key-sequence to execute in edit buffer: ")
769 (org-babel-do-in-edit-buffer
770 (call-interactively
771 (key-binding (or key (read-key-sequence nil))))))
772
86fbb8ca
CD		 773(defvar org-bracket-link-regexp)
774;;;###autoload
775(defun org-babel-open-src-block-result (&optional re-run)
776 "If `point' is on a src block then open the results of the
777source code block, otherwise return nil. With optional prefix
778argument RE-RUN the source-code block is evaluated even if
779results already exist."
780 (interactive "P")
3ab2c837
BG		 781 (let ((info (org-babel-get-src-block-info)))
782 (when info
783 (save-excursion
784 ;; go to the results, if there aren't any then run the block
785 (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
786 (progn (org-babel-execute-src-block)
787 (org-babel-where-is-src-block-result))))
788 (end-of-line 1)
789 (while (looking-at "[\n\r\t\f ]") (forward-char 1))
790 ;; open the results
791 (if (looking-at org-bracket-link-regexp)
792 ;; file results
793 (org-open-at-point)
794 (let ((r (org-babel-format-result
795 (org-babel-read-result) (cdr (assoc :sep (nth 2 info))))))
796 (pop-to-buffer (get-buffer-create "*Org-Babel Results*"))
797 (delete-region (point-min) (point-max))
798 (insert r)))
799 t))))
86fbb8ca 800
acedf35c
CD		 801;;;###autoload
802(defmacro org-babel-map-src-blocks (file &rest body)
803 "Evaluate BODY forms on each source-block in FILE.
804If FILE is nil evaluate BODY forms on source blocks in current
805buffer. During evaluation of BODY the following local variables
806are set relative to the currently matched code block.
807
808full-block ------- string holding the entirety of the code block
809beg-block -------- point at the beginning of the code block
810end-block -------- point at the end of the matched code block
811lang ------------- string holding the language of the code block
812beg-lang --------- point at the beginning of the lang
813end-lang --------- point at the end of the lang
814switches --------- string holding the switches
815beg-switches ----- point at the beginning of the switches
816end-switches ----- point at the end of the switches
817header-args ------ string holding the header-args
818beg-header-args -- point at the beginning of the header-args
819end-header-args -- point at the end of the header-args
820body ------------- string holding the body of the code block
821beg-body --------- point at the beginning of the body
822end-body --------- point at the end of the body"
823 (declare (indent 1))
824 (let ((tempvar (make-symbol "file")))
825 `(let* ((,tempvar ,file)
826 (visited-p (or (null ,tempvar)
827 (get-file-buffer (expand-file-name ,tempvar))))
828 (point (point)) to-be-removed)
829 (save-window-excursion
830 (when ,tempvar (find-file ,tempvar))
831 (setq to-be-removed (current-buffer))
832 (goto-char (point-min))
833 (while (re-search-forward org-babel-src-block-regexp nil t)
834 (goto-char (match-beginning 0))
835 (let ((full-block (match-string 0))
836 (beg-block (match-beginning 0))
837 (end-block (match-end 0))
838 (lang (match-string 2))
839 (beg-lang (match-beginning 2))
840 (end-lang (match-end 2))
841 (switches (match-string 3))
842 (beg-switches (match-beginning 3))
843 (end-switches (match-end 3))
844 (header-args (match-string 4))
845 (beg-header-args (match-beginning 4))
846 (end-header-args (match-end 4))
847 (body (match-string 5))
848 (beg-body (match-beginning 5))
849 (end-body (match-end 5)))
850 ,@body
851 (goto-char end-block))))
852 (unless visited-p (kill-buffer to-be-removed))
853 (goto-char point))))
e66ba1df 854(def-edebug-spec org-babel-map-src-blocks (form body))
acedf35c 855
3ab2c837
BG		 856;;;###autoload
857(defmacro org-babel-map-inline-src-blocks (file &rest body)
858 "Evaluate BODY forms on each inline source-block in FILE.
859If FILE is nil evaluate BODY forms on source blocks in current
860buffer."
861 (declare (indent 1))
862 (let ((tempvar (make-symbol "file")))
863 `(let* ((,tempvar ,file)
864 (visited-p (or (null ,tempvar)
865 (get-file-buffer (expand-file-name ,tempvar))))
866 (point (point)) to-be-removed)
867 (save-window-excursion
868 (when ,tempvar (find-file ,tempvar))
869 (setq to-be-removed (current-buffer))
870 (goto-char (point-min))
871 (while (re-search-forward org-babel-inline-src-block-regexp nil t)
872 (goto-char (match-beginning 1))
873 (save-match-data ,@body)
874 (goto-char (match-end 0))))
875 (unless visited-p (kill-buffer to-be-removed))
876 (goto-char point))))
e66ba1df
BG		 877(def-edebug-spec org-babel-map-inline-src-blocks (form body))
878
879(defvar org-babel-lob-one-liner-regexp)
880;;;###autoload
881(defmacro org-babel-map-call-lines (file &rest body)
882 "Evaluate BODY forms on each call line in FILE.
883If FILE is nil evaluate BODY forms on source blocks in current
884buffer."
885 (declare (indent 1))
886 (let ((tempvar (make-symbol "file")))
887 `(let* ((,tempvar ,file)
888 (visited-p (or (null ,tempvar)
889 (get-file-buffer (expand-file-name ,tempvar))))
890 (point (point)) to-be-removed)
891 (save-window-excursion
892 (when ,tempvar (find-file ,tempvar))
893 (setq to-be-removed (current-buffer))
894 (goto-char (point-min))
895 (while (re-search-forward org-babel-lob-one-liner-regexp nil t)
896 (goto-char (match-beginning 1))
897 (save-match-data ,@body)
898 (goto-char (match-end 0))))
899 (unless visited-p (kill-buffer to-be-removed))
900 (goto-char point))))
901(def-edebug-spec org-babel-map-call-lines (form body))
3ab2c837 902
153ae947
BG		 903;;;###autoload
904(defmacro org-babel-map-executables (file &rest body)
905 (declare (indent 1))
906 (let ((tempvar (make-symbol "file"))
907 (rx (make-symbol "rx")))
908 `(let* ((,tempvar ,file)
909 (,rx (concat "\\(" org-babel-src-block-regexp
910 "\\|" org-babel-inline-src-block-regexp
911 "\\|" org-babel-lob-one-liner-regexp "\\)"))
912 (visited-p (or (null ,tempvar)
913 (get-file-buffer (expand-file-name ,tempvar))))
914 (point (point)) to-be-removed)
915 (save-window-excursion
916 (when ,tempvar (find-file ,tempvar))
917 (setq to-be-removed (current-buffer))
918 (goto-char (point-min))
919 (while (re-search-forward ,rx nil t)
920 (goto-char (match-beginning 1))
921 (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1))
922 (save-match-data ,@body)
923 (goto-char (match-end 0))))
924 (unless visited-p (kill-buffer to-be-removed))
925 (goto-char point))))
926(def-edebug-spec org-babel-map-executables (form body))
927
86fbb8ca
CD		 928;;;###autoload
929(defun org-babel-execute-buffer (&optional arg)
930 "Execute source code blocks in a buffer.
931Call `org-babel-execute-src-block' on every source block in
932the current buffer."
933 (interactive "P")
3ab2c837 934 (org-babel-eval-wipe-error-buffer)
afe98dfa 935 (org-save-outline-visibility t
153ae947
BG		 936 (org-babel-map-executables nil
937 (if (looking-at org-babel-lob-one-liner-regexp)
938 (org-babel-lob-execute-maybe)
939 (org-babel-execute-src-block arg)))))
86fbb8ca
CD		 940
941;;;###autoload
942(defun org-babel-execute-subtree (&optional arg)
943 "Execute source code blocks in a subtree.
944Call `org-babel-execute-src-block' on every source block in
945the current subtree."
946 (interactive "P")
947 (save-restriction
948 (save-excursion
949 (org-narrow-to-subtree)
afe98dfa 950 (org-babel-execute-buffer arg)
86fbb8ca
CD		 951 (widen))))
952
953;;;###autoload
954(defun org-babel-sha1-hash (&optional info)
955 "Generate an sha1 hash based on the value of info."
956 (interactive)
afe98dfa
CD		 957 (let ((print-level nil)
958 (info (or info (org-babel-get-src-block-info))))
959 (setf (nth 2 info)
960 (sort (copy-sequence (nth 2 info))
961 (lambda (a b) (string< (car a) (car b)))))
3ab2c837
BG		 962 (labels ((rm (lst)
963 (dolist (p '("replace" "silent" "append" "prepend"))
964 (setq lst (remove p lst)))
965 lst)
966 (norm (arg)
967 (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
e66ba1df 968 (copy-sequence (cdr arg))
3ab2c837
BG		 969 (cdr arg))))
970 (when (and v (not (and (sequencep v)
971 (not (consp v))
972 (= (length v) 0))))
973 (cond
974 ((and (listp v) ; lists are sorted
975 (member (car arg) '(:result-params)))
976 (sort (rm v) #'string<))
977 ((and (stringp v) ; strings are sorted
978 (member (car arg) '(:results :exports)))
979 (mapconcat #'identity (sort (rm (split-string v))
980 #'string<) " "))
981 (t v))))))
982 ((lambda (hash)
983 (when (org-called-interactively-p 'interactive) (message hash)) hash)
984 (let ((it (format "%s-%s"
afe98dfa
CD		 985 (mapconcat
986 #'identity
3ab2c837
BG		 987 (delq nil (mapcar (lambda (arg)
988 (let ((normalized (norm arg)))
989 (when normalized
990 (format "%S" normalized))))
991 (nth 2 info))) ":")
992 (nth 1 info))))
993 (sha1 it))))))
994
995(defun org-babel-current-result-hash ()
86fbb8ca 996 "Return the in-buffer hash associated with INFO."
3ab2c837 997 (org-babel-where-is-src-block-result)
86fbb8ca
CD		 998 (org-babel-clean-text-properties (match-string 3)))
999
1000(defun org-babel-hide-hash ()
1001 "Hide the hash in the current results line.
1002Only the initial `org-babel-hash-show' characters of the hash
1003will remain visible."
1004 (add-to-invisibility-spec '(org-babel-hide-hash . t))
1005 (save-excursion
1006 (when (and (re-search-forward org-babel-result-regexp nil t)
1007 (match-string 3))
1008 (let* ((start (match-beginning 3))
1009 (hide-start (+ org-babel-hash-show start))
1010 (end (match-end 3))
1011 (hash (match-string 3))
1012 ov1 ov2)
1013 (setq ov1 (make-overlay start hide-start))
1014 (setq ov2 (make-overlay hide-start end))
1015 (overlay-put ov2 'invisible 'org-babel-hide-hash)
1016 (overlay-put ov1 'babel-hash hash)))))
1017
1018(defun org-babel-hide-all-hashes ()
1019 "Hide the hash in the current buffer.
1020Only the initial `org-babel-hash-show' characters of each hash
1021will remain visible. This function should be called as part of
1022the `org-mode-hook'."
1023 (save-excursion
1024 (while (re-search-forward org-babel-result-regexp nil t)
1025 (goto-char (match-beginning 0))
1026 (org-babel-hide-hash)
1027 (goto-char (match-end 0)))))
1028(add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
1029
1030(defun org-babel-hash-at-point (&optional point)
1031 "Return the value of the hash at POINT.
1032The hash is also added as the last element of the kill ring.
1033This can be called with C-c C-c."
1034 (interactive)
1035 (let ((hash (car (delq nil (mapcar
1036 (lambda (ol) (overlay-get ol 'babel-hash))
1037 (overlays-at (or point (point))))))))
1038 (when hash (kill-new hash) (message hash))))
1039(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
1040
153ae947
BG		 1041(defun org-babel-result-hide-spec ()
1042 "Hide portions of results lines.
1043Add `org-babel-hide-result' as an invisibility spec for hiding
1044portions of results lines."
1045 (add-to-invisibility-spec '(org-babel-hide-result . t)))
1046(add-hook 'org-mode-hook 'org-babel-result-hide-spec)
1047
1048(defvar org-babel-hide-result-overlays nil
1049 "Overlays hiding results.")
1050
1051(defun org-babel-result-hide-all ()
1052 "Fold all results in the current buffer."
1053 (interactive)
1054 (org-babel-show-result-all)
1055 (save-excursion
1056 (while (re-search-forward org-babel-result-regexp nil t)
1057 (save-excursion (goto-char (match-beginning 0))
1058 (org-babel-hide-result-toggle-maybe)))))
1059
1060(defun org-babel-show-result-all ()
1061 "Unfold all results in the current buffer."
1062 (mapc 'delete-overlay org-babel-hide-result-overlays)
1063 (setq org-babel-hide-result-overlays nil))
1064
1065;;;###autoload
1066(defun org-babel-hide-result-toggle-maybe ()
1067 "Toggle visibility of result at point."
1068 (interactive)
1069 (let ((case-fold-search t))
1070 (if (save-excursion
1071 (beginning-of-line 1)
1072 (looking-at org-babel-result-regexp))
1073 (progn (org-babel-hide-result-toggle)
1074 t) ;; to signal that we took action
1075 nil))) ;; to signal that we did not
1076
1077(defun org-babel-hide-result-toggle (&optional force)
1078 "Toggle the visibility of the current result."
1079 (interactive)
1080 (save-excursion
1081 (beginning-of-line)
1082 (if (re-search-forward org-babel-result-regexp nil t)
1083 (let ((start (progn (beginning-of-line 2) (- (point) 1)))
1084 (end (progn
1085 (while (looking-at org-babel-multi-line-header-regexp)
1086 (forward-line 1))
1087 (goto-char (- (org-babel-result-end) 1)) (point)))
1088 ov)
1089 (if (memq t (mapcar (lambda (overlay)
1090 (eq (overlay-get overlay 'invisible)
1091 'org-babel-hide-result))
1092 (overlays-at start)))
1093 (if (or (not force) (eq force 'off))
1094 (mapc (lambda (ov)
1095 (when (member ov org-babel-hide-result-overlays)
1096 (setq org-babel-hide-result-overlays
1097 (delq ov org-babel-hide-result-overlays)))
1098 (when (eq (overlay-get ov 'invisible)
1099 'org-babel-hide-result)
1100 (delete-overlay ov)))
1101 (overlays-at start)))
1102 (setq ov (make-overlay start end))
1103 (overlay-put ov 'invisible 'org-babel-hide-result)
1104 ;; make the block accessible to isearch
1105 (overlay-put
1106 ov 'isearch-open-invisible
1107 (lambda (ov)
1108 (when (member ov org-babel-hide-result-overlays)
1109 (setq org-babel-hide-result-overlays
1110 (delq ov org-babel-hide-result-overlays)))
1111 (when (eq (overlay-get ov 'invisible)
1112 'org-babel-hide-result)
1113 (delete-overlay ov))))
1114 (push ov org-babel-hide-result-overlays)))
1115 (error "Not looking at a result line"))))
1116
1117;; org-tab-after-check-for-cycling-hook
1118(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
1119;; Remove overlays when changing major mode
1120(add-hook 'org-mode-hook
1121 (lambda () (org-add-hook 'change-major-mode-hook
1122 'org-babel-show-result-all 'append 'local)))
1123
86fbb8ca
CD		 1124(defvar org-file-properties)
1125(defun org-babel-params-from-properties (&optional lang)
1126 "Retrieve parameters specified as properties.
1127Return an association list of any source block params which
1128may be specified in the properties of the current outline entry."
1129 (save-match-data
1130 (let (val sym)
e66ba1df
BG		 1131 (org-babel-parse-multiple-vars
1132 (delq nil
86fbb8ca 1133 (mapcar
e66ba1df
BG		 1134 (lambda (header-arg)
1135 (and (setq val (org-entry-get (point) header-arg t))
1136 (cons (intern (concat ":" header-arg))
1137 (org-babel-read val))))
1138 (mapcar
1139 'symbol-name
1140 (append
1141 org-babel-header-arg-names
1142 (progn
1143 (setq sym (intern (concat "org-babel-header-arg-names:"
1144 lang)))
1145 (and (boundp sym) (eval sym)))))))))))
86fbb8ca
CD		 1146
1147(defvar org-src-preserve-indentation)
1148(defun org-babel-parse-src-block-match ()
1149 "Parse the results from a match of the `org-babel-src-block-regexp'."
1150 (let* ((block-indentation (length (match-string 1)))
1151 (lang (org-babel-clean-text-properties (match-string 2)))
1152 (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
1153 (switches (match-string 3))
3ab2c837
BG		 1154 (body (org-babel-clean-text-properties
1155 (let* ((body (match-string 5))
1156 (sub-length (- (length body) 1)))
e66ba1df
BG		 1157 (if (and (> sub-length 0)
1158 (string= "\n" (substring body sub-length)))
3ab2c837 1159 (substring body 0 sub-length)
e66ba1df 1160 (or body "")))))
86fbb8ca 1161 (preserve-indentation (or org-src-preserve-indentation
eb2adf0a
BG		 1162 (save-match-data
1163 (string-match "-i\\>" switches)))))
86fbb8ca
CD		 1164 (list lang
1165 ;; get block body less properties, protective commas, and indentation
1166 (with-temp-buffer
1167 (save-match-data
153ae947 1168 (insert (org-babel-strip-protective-commas body lang))
86fbb8ca
CD		 1169 (unless preserve-indentation (org-do-remove-indentation))
1170 (buffer-string)))
1171 (org-babel-merge-params
1172 org-babel-default-header-args
86fbb8ca
CD		 1173 (org-babel-params-from-properties lang)
1174 (if (boundp lang-headers) (eval lang-headers) nil)
1175 (org-babel-parse-header-arguments
1176 (org-babel-clean-text-properties (or (match-string 4) ""))))
1177 switches
1178 block-indentation)))
1179
1180(defun org-babel-parse-inline-src-block-match ()
1181 "Parse the results from a match of the `org-babel-inline-src-block-regexp'."
1182 (let* ((lang (org-babel-clean-text-properties (match-string 2)))
1183 (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
1184 (list lang
1185 (org-babel-strip-protective-commas
153ae947 1186 (org-babel-clean-text-properties (match-string 5)) lang)
86fbb8ca
CD		 1187 (org-babel-merge-params
1188 org-babel-default-inline-header-args
86fbb8ca
CD		 1189 (org-babel-params-from-properties lang)
1190 (if (boundp lang-headers) (eval lang-headers) nil)
1191 (org-babel-parse-header-arguments
1192 (org-babel-clean-text-properties (or (match-string 4) "")))))))
1193
e66ba1df
BG		 1194(defun org-babel-balanced-split (string alts)
1195 "Split STRING on instances of ALTS.
1196ALTS is a cons of two character options where each option may be
1197either the numeric code of a single character or a list of
1198character alternatives. For example to split on balanced
1199instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
b73f1974 1200 (flet ((matches (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))
e66ba1df
BG		 1201 (matched (ch last)
1202 (if (consp alts)
1203 (and (matches ch (cdr alts))
1204 (matches last (car alts)))
1205 (matches ch alts))))
1206 (let ((balance 0) (quote nil) (partial nil) (lst nil) (last 0))
1207 (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
1208 (setq balance (+ balance
1209 (cond ((or (equal 91 ch) (equal 40 ch)) 1)
1210 ((or (equal 93 ch) (equal 41 ch)) -1)
1211 (t 0))))
1212 (when (and (equal 34 ch) (not (equal 92 last)))
1213 (setq quote (not quote)))
1214 (setq partial (cons ch partial))
1215 (when (and (= balance 0) (not quote) (matched ch last))
1216 (setq lst (cons (apply #'string (nreverse
1217 (if (consp alts)
1218 (cddr partial)
1219 (cdr partial))))
1220 lst))
1221 (setq partial nil))
1222 (setq last ch))
1223 (string-to-list string))
1224 (nreverse (cons (apply #'string (nreverse partial)) lst)))))
1225
1226(defun org-babel-join-splits-near-ch (ch list)
1227 "Join splits where \"=\" is on either end of the split."
1228 (flet ((last= (str) (= ch (aref str (1- (length str)))))
1229 (first= (str) (= ch (aref str 0))))
1230 (reverse
1231 (org-reduce (lambda (acc el)
1232 (let ((head (car acc)))
1233 (if (and head (or (last= head) (first= el)))
1234 (cons (concat head el) (cdr acc))
1235 (cons el acc))))
1236 list :initial-value nil))))
1237
86fbb8ca
CD		 1238(defun org-babel-parse-header-arguments (arg-string)
1239 "Parse a string of header arguments returning an alist."
acedf35c 1240 (when (> (length arg-string) 0)
e66ba1df
BG		 1241 (org-babel-parse-multiple-vars
1242 (delq nil
1243 (mapcar
1244 (lambda (arg)
1245 (if (string-match
1246 "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
1247 arg)
1248 (cons (intern (match-string 1 arg))
1249 (org-babel-read (org-babel-chomp (match-string 2 arg))))
1250 (cons (intern (org-babel-chomp arg)) nil)))
1251 ((lambda (raw)
1252 (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))
1253 (org-babel-balanced-split arg-string '((32 9) . 58))))))))
1254
1255(defun org-babel-parse-multiple-vars (header-arguments)
1256 "Expand multiple variable assignments behind a single :var keyword.
1257
1258This allows expression of multiple variables with one :var as
1259shown below.
1260
1261#+PROPERTY: var foo=1, bar=2"
1262 (let (results)
1263 (mapc (lambda (pair)
1264 (if (eq (car pair) :var)
1265 (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
1266 (org-babel-join-splits-near-ch
1267 61 (org-babel-balanced-split (cdr pair) 32)))
1268 (push pair results)))
1269 header-arguments)
1270 (nreverse results)))
86fbb8ca
CD		 1271
1272(defun org-babel-process-params (params)
afe98dfa 1273 "Expand variables in PARAMS and add summary parameters."
e66ba1df
BG		 1274 (let* ((processed-vars (mapcar (lambda (el)
1275 (if (consp (cdr el))
1276 (cdr el)
1277 (org-babel-ref-parse (cdr el))))
1278 (org-babel-get-header params :var)))
1279 (vars-and-names (if (and (assoc :colname-names params)
1280 (assoc :rowname-names params))
1281 (list processed-vars)
1282 (org-babel-disassemble-tables
1283 processed-vars
1284 (cdr (assoc :hlines params))
1285 (cdr (assoc :colnames params))
1286 (cdr (assoc :rownames params)))))
3ab2c837 1287 (raw-result (or (cdr (assoc :results params)) ""))
afe98dfa 1288 (result-params (append
3ab2c837
BG		 1289 (split-string (if (stringp raw-result)
1290 raw-result
1291 (eval raw-result)))
afe98dfa
CD		 1292 (cdr (assoc :result-params params)))))
1293 (append
1294 (mapcar (lambda (var) (cons :var var)) (car vars-and-names))
1295 (list
3ab2c837
BG		 1296 (cons :colname-names (or (cdr (assoc :colname-names params))
1297 (cadr vars-and-names)))
1298 (cons :rowname-names (or (cdr (assoc :rowname-names params))
1299 (caddr vars-and-names)))
afe98dfa
CD		 1300 (cons :result-params result-params)
1301 (cons :result-type (cond ((member "output" result-params) 'output)
1302 ((member "value" result-params) 'value)
1303 (t 'value))))
1304 (org-babel-get-header params :var 'other))))
86fbb8ca
CD		 1305
1306;; row and column names
1307(defun org-babel-del-hlines (table)
1308 "Remove all 'hlines from TABLE."
1309 (remove 'hline table))
1310
1311(defun org-babel-get-colnames (table)
1312 "Return the column names of TABLE.
1313Return a cons cell, the `car' of which contains the TABLE less
1314colnames, and the `cdr' of which contains a list of the column
1315names."
1316 (if (equal 'hline (nth 1 table))
1317 (cons (cddr table) (car table))
1318 (cons (cdr table) (car table))))
1319
1320(defun org-babel-get-rownames (table)
1321 "Return the row names of TABLE.
1322Return a cons cell, the `car' of which contains the TABLE less
1323colnames, and the `cdr' of which contains a list of the column
1324names. Note: this function removes any hlines in TABLE."
1325 (flet ((trans (table) (apply #'mapcar* #'list table)))
afe98dfa
CD		 1326 (let* ((width (apply 'max
1327 (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
86fbb8ca
CD		 1328 (table (trans (mapcar (lambda (row)
1329 (if (not (equal row 'hline))
1330 row
1331 (setq row '())
afe98dfa
CD		 1332 (dotimes (n width)
1333 (setq row (cons 'hline row)))
86fbb8ca
CD		 1334 row))
1335 table))))
1336 (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
1337 (trans (cdr table)))
1338 (remove 'hline (car table))))))
1339
1340(defun org-babel-put-colnames (table colnames)
1341 "Add COLNAMES to TABLE if they exist."
1342 (if colnames (apply 'list colnames 'hline table) table))
1343
1344(defun org-babel-put-rownames (table rownames)
1345 "Add ROWNAMES to TABLE if they exist."
1346 (if rownames
1347 (mapcar (lambda (row)
1348 (if (listp row)
1349 (cons (or (pop rownames) "") row)
1350 row)) table)
1351 table))
1352
1353(defun org-babel-pick-name (names selector)
afe98dfa
CD		 1354 "Select one out of an alist of row or column names.
1355SELECTOR can be either a list of names in which case those names
1356will be returned directly, or an index into the list NAMES in
1357which case the indexed names will be return."
1358 (if (listp selector)
1359 selector
1360 (when names
1361 (if (and selector (symbolp selector) (not (equal t selector)))
1362 (cdr (assoc selector names))
1363 (if (integerp selector)
1364 (nth (- selector 1) names)
1365 (cdr (car (last names))))))))
86fbb8ca
CD		 1366
1367(defun org-babel-disassemble-tables (vars hlines colnames rownames)
1368 "Parse tables for further processing.
1369Process the variables in VARS according to the HLINES,
1370ROWNAMES and COLNAMES header arguments. Return a list consisting
1371of the vars, cnames and rnames."
1372 (let (cnames rnames)
1373 (list
1374 (mapcar
1375 (lambda (var)
1376 (when (listp (cdr var))
1377 (when (and (not (equal colnames "no"))
1378 (or colnames (and (equal (nth 1 (cdr var)) 'hline)
1379 (not (member 'hline (cddr (cdr var)))))))
1380 (let ((both (org-babel-get-colnames (cdr var))))
1381 (setq cnames (cons (cons (car var) (cdr both))
1382 cnames))
1383 (setq var (cons (car var) (car both)))))
1384 (when (and rownames (not (equal rownames "no")))
1385 (let ((both (org-babel-get-rownames (cdr var))))
1386 (setq rnames (cons (cons (car var) (cdr both))
1387 rnames))
1388 (setq var (cons (car var) (car both)))))
1389 (when (and hlines (not (equal hlines "yes")))
1390 (setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
1391 var)
1392 vars)
e66ba1df 1393 (reverse cnames) (reverse rnames))))
86fbb8ca
CD		 1394
1395(defun org-babel-reassemble-table (table colnames rownames)
1396 "Add column and row names to a table.
1397Given a TABLE and set of COLNAMES and ROWNAMES add the names
1398to the table for reinsertion to org-mode."
1399 (if (listp table)
1400 ((lambda (table)
1401 (if (and colnames (listp (car table)) (= (length (car table))
1402 (length colnames)))
1403 (org-babel-put-colnames table colnames) table))
1404 (if (and rownames (= (length table) (length rownames)))
1405 (org-babel-put-rownames table rownames) table))
1406 table))
1407
1408(defun org-babel-where-is-src-block-head ()
1409 "Find where the current source block begins.
1410Return the point at the beginning of the current source
1411block. Specifically at the beginning of the #+BEGIN_SRC line.
1412If the point is not on a source block then return nil."
1413 (let ((initial (point)) top bottom)
1414 (or
3ab2c837 1415 (save-excursion ;; on a source name line or a #+header line
86fbb8ca 1416 (beginning-of-line 1)
3ab2c837
BG		 1417 (and (or (looking-at org-babel-src-name-regexp)
1418 (looking-at org-babel-multi-line-header-regexp))
1419 (progn
1420 (while (and (forward-line 1)
1421 (looking-at org-babel-multi-line-header-regexp)))
1422 (looking-at org-babel-src-block-regexp))
86fbb8ca
CD		 1423 (point)))
1424 (save-excursion ;; on a #+begin_src line
1425 (beginning-of-line 1)
1426 (and (looking-at org-babel-src-block-regexp)
1427 (point)))
1428 (save-excursion ;; inside a src block
1429 (and
1430 (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point))
1431 (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point))
1432 (< top initial) (< initial bottom)
1433 (progn (goto-char top) (beginning-of-line 1)
1434 (looking-at org-babel-src-block-regexp))
1435 (point))))))
1436
afe98dfa
CD		 1437;;;###autoload
1438(defun org-babel-goto-src-block-head ()
1439 "Go to the beginning of the current code block."
1440 (interactive)
1441 ((lambda (head)
1442 (if head (goto-char head) (error "not currently in a code block")))
1443 (org-babel-where-is-src-block-head)))
1444
86fbb8ca
CD		 1445;;;###autoload
1446(defun org-babel-goto-named-src-block (name)
1447 "Go to a named source-code block."
1448 (interactive
1449 (let ((completion-ignore-case t))
1450 (list (org-icompleting-read "source-block name: "
1451 (org-babel-src-block-names) nil t))))
1452 (let ((point (org-babel-find-named-block name)))
1453 (if point
1454 ;; taken from `org-open-at-point'
1455 (progn (goto-char point) (org-show-context))
1456 (message "source-code block '%s' not found in this buffer" name))))
1457
1458(defun org-babel-find-named-block (name)
1459 "Find a named source-code block.
1460Return the location of the source block identified by source
1461NAME, or nil if no such block exists. Set match data according to
1462org-babel-named-src-block-regexp."
1463 (save-excursion
1464 (let ((case-fold-search t)
1465 (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
1466 (goto-char (point-min))
1467 (when (or (re-search-forward regexp nil t)
e66ba1df 1468 (re-search-backward regexp nil t))
86fbb8ca
CD		 1469 (match-beginning 0)))))
1470
1471(defun org-babel-src-block-names (&optional file)
1472 "Returns the names of source blocks in FILE or the current buffer."
1473 (save-excursion
1474 (when file (find-file file)) (goto-char (point-min))
1475 (let (names)
1476 (while (re-search-forward org-babel-src-name-w-name-regexp nil t)
e66ba1df 1477 (setq names (cons (match-string 3) names)))
86fbb8ca
CD		 1478 names)))
1479
1480;;;###autoload
1481(defun org-babel-goto-named-result (name)
1482 "Go to a named result."
1483 (interactive
1484 (let ((completion-ignore-case t))
1485 (list (org-icompleting-read "source-block name: "
1486 (org-babel-result-names) nil t))))
1487 (let ((point (org-babel-find-named-result name)))
1488 (if point
1489 ;; taken from `org-open-at-point'
1490 (progn (goto-char point) (org-show-context))
1491 (message "result '%s' not found in this buffer" name))))
1492
e66ba1df 1493(defun org-babel-find-named-result (name &optional point)
86fbb8ca
CD		 1494 "Find a named result.
1495Return the location of the result named NAME in the current
1496buffer or nil if no such result exists."
1497 (save-excursion
e66ba1df
BG		 1498 (goto-char (or point (point-min)))
1499 (catch 'is-a-code-block
1500 (when (re-search-forward
1501 (concat org-babel-result-regexp
8c8b834f 1502 "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
e66ba1df 1503 (when (and (string= "name" (downcase (match-string 1)))
153ae947
BG		 1504 (or (beginning-of-line 1)
1505 (looking-at org-babel-src-block-regexp)
e66ba1df
BG		 1506 (looking-at org-babel-multi-line-header-regexp)))
1507 (throw 'is-a-code-block (org-babel-find-named-result name (point))))
1508 (beginning-of-line 0) (point)))))
86fbb8ca
CD		 1509
1510(defun org-babel-result-names (&optional file)
1511 "Returns the names of results in FILE or the current buffer."
1512 (save-excursion
1513 (when file (find-file file)) (goto-char (point-min))
1514 (let (names)
1515 (while (re-search-forward org-babel-result-w-name-regexp nil t)
3ab2c837 1516 (setq names (cons (match-string 4) names)))
86fbb8ca
CD		 1517 names)))
1518
1519;;;###autoload
1520(defun org-babel-next-src-block (&optional arg)
1521 "Jump to the next source block.
1522With optional prefix argument ARG, jump forward ARG many source blocks."
1523 (interactive "P")
1524 (when (looking-at org-babel-src-block-regexp) (forward-char 1))
afe98dfa
CD		 1525 (condition-case nil
1526 (re-search-forward org-babel-src-block-regexp nil nil (or arg 1))
1527 (error (error "No further code blocks")))
86fbb8ca
CD		 1528 (goto-char (match-beginning 0)) (org-show-context))
1529
1530;;;###autoload
1531(defun org-babel-previous-src-block (&optional arg)
1532 "Jump to the previous source block.
1533With optional prefix argument ARG, jump backward ARG many source blocks."
1534 (interactive "P")
afe98dfa
CD		 1535 (condition-case nil
1536 (re-search-backward org-babel-src-block-regexp nil nil (or arg 1))
1537 (error (error "No previous code blocks")))
86fbb8ca
CD		 1538 (goto-char (match-beginning 0)) (org-show-context))
1539
afe98dfa
CD		 1540(defvar org-babel-load-languages)
1541
1542;;;###autoload
1543(defun org-babel-mark-block ()
1544 "Mark current src block"
1545 (interactive)
1546 ((lambda (head)
1547 (when head
1548 (save-excursion
1549 (goto-char head)
1550 (looking-at org-babel-src-block-regexp))
1551 (push-mark (match-end 5) nil t)
1552 (goto-char (match-beginning 5))))
1553 (org-babel-where-is-src-block-head)))
1554
1555(defun org-babel-demarcate-block (&optional arg)
1556 "Wrap or split the code in the region or on the point.
1557When called from inside of a code block the current block is
1558split. When called from outside of a code block a new code block
1559is created. In both cases if the region is demarcated and if the
1560region is not active then the point is demarcated."
1561 (interactive "P")
1562 (let ((info (org-babel-get-src-block-info 'light))
e66ba1df
BG		 1563 (headers (progn (org-babel-where-is-src-block-head)
1564 (match-string 4)))
afe98dfa
CD		 1565 (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
1566 (if info
1567 (mapc
1568 (lambda (place)
1569 (save-excursion
1570 (goto-char place)
1571 (let ((lang (nth 0 info))
1572 (indent (make-string (nth 5 info) ? )))
1573 (when (string-match "^[[:space:]]*$"
1574 (buffer-substring (point-at-bol)
1575 (point-at-eol)))
1576 (delete-region (point-at-bol) (point-at-eol)))
e66ba1df
BG		 1577 (insert (concat
1578 (if (looking-at "^") "" "\n")
1579 indent "#+end_src\n"
1580 (if arg stars indent) "\n"
1581 indent "#+begin_src " lang
1582 (if (> (length headers) 1)
1583 (concat " " headers) headers)
1584 (if (looking-at "[\n\r]")
1585 ""
1586 (concat "\n" (make-string (current-column) ? )))))))
afe98dfa
CD		 1587 (move-end-of-line 2))
1588 (sort (if (region-active-p) (list (mark) (point)) (list (point))) #'>))
1589 (let ((start (point))
1590 (lang (org-icompleting-read "Lang: "
1591 (mapcar (lambda (el) (symbol-name (car el)))
1592 org-babel-load-languages)))
1593 (body (delete-and-extract-region
1594 (if (region-active-p) (mark) (point)) (point))))
1595 (insert (concat (if (looking-at "^") "" "\n")
1596 (if arg (concat stars "\n") "")
1597 "#+begin_src " lang "\n"
1598 body
1599 (if (or (= (length body) 0)
1600 (string-match "[\r\n]$" body)) "" "\n")
1601 "#+end_src\n"))
1602 (goto-char start) (move-end-of-line 1)))))
1603
86fbb8ca
CD		 1604(defvar org-babel-lob-one-liner-regexp)
1605(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
1606 "Find where the current source block results begin.
1607Return the point at the beginning of the result of the current
1608source block. Specifically at the beginning of the results line.
1609If no result exists for this block then create a results line
1610following the source block."
1611 (save-excursion
3ab2c837
BG		 1612 (let* ((on-lob-line (save-excursion
1613 (beginning-of-line 1)
1614 (looking-at org-babel-lob-one-liner-regexp)))
e66ba1df
BG		 1615 (inlinep (when (org-babel-get-inline-src-block-matches)
1616 (match-end 0)))
86fbb8ca 1617 (name (if on-lob-line
153ae947 1618 (mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
e66ba1df 1619 (nth 4 (or info (org-babel-get-src-block-info 'light)))))
86fbb8ca
CD		 1620 (head (unless on-lob-line (org-babel-where-is-src-block-head)))
1621 found beg end)
1622 (when head (goto-char head))
1623 (setq
1624 found ;; was there a result (before we potentially insert one)
1625 (or
3ab2c837 1626 inlinep
86fbb8ca
CD		 1627 (and
1628 ;; named results:
1629 ;; - return t if it is found, else return nil
1630 ;; - if it does not need to be rebuilt, then don't set end
1631 ;; - if it does need to be rebuilt then do set end
1632 name (setq beg (org-babel-find-named-result name))
1633 (prog1 beg
1634 (when (and hash (not (string= hash (match-string 3))))
1635 (goto-char beg) (setq end beg) ;; beginning of result
1636 (forward-line 1)
1637 (delete-region end (org-babel-result-end)) nil)))
1638 (and
1639 ;; unnamed results:
1640 ;; - return t if it is found, else return nil
1641 ;; - if it is found, and the hash doesn't match, delete and set end
1642 (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
1643 (progn (end-of-line 1)
1644 (if (eobp) (insert "\n") (forward-char 1))
1645 (setq end (point))
1646 (or (and (not name)
1647 (progn ;; unnamed results line already exists
1648 (re-search-forward "[^ \f\t\n\r\v]" nil t)
1649 (beginning-of-line 1)
1650 (looking-at
1651 (concat org-babel-result-regexp "\n")))
1652 (prog1 (point)
1653 ;; must remove and rebuild if hash!=old-hash
1654 (if (and hash (not (string= hash (match-string 3))))
1655 (prog1 nil
1656 (forward-line 1)
1657 (delete-region
1658 end (org-babel-result-end)))
1659 (setq end nil)))))))))
1660 (if (and insert end)
1661 (progn
1662 (goto-char end)
1663 (unless beg
1664 (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
1665 (insert (concat
1666 (if indent
1667 (mapconcat
1668 (lambda (el) " ")
afe98dfa 1669 (org-number-sequence 1 indent) "")
86fbb8ca 1670 "")
153ae947 1671 "#+" org-babel-results-keyword
86fbb8ca
CD		 1672 (when hash (concat "["hash"]"))
1673 ":"
1674 (when name (concat " " name)) "\n"))
1675 (unless beg (insert "\n") (backward-char))
1676 (beginning-of-line 0)
1677 (if hash (org-babel-hide-hash))
1678 (point))
1679 found))))
1680
1681(defvar org-block-regexp)
1682(defun org-babel-read-result ()
1683 "Read the result at `point' into emacs-lisp."
1684 (let ((case-fold-search t) result-string)
1685 (cond
1686 ((org-at-table-p) (org-babel-read-table))
3ab2c837 1687 ((org-at-item-p) (org-babel-read-list))
86fbb8ca
CD		 1688 ((looking-at org-bracket-link-regexp) (org-babel-read-link))
1689 ((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
1690 ((looking-at "^[ \t]*: ")
1691 (setq result-string
1692 (org-babel-trim
1693 (mapconcat (lambda (line)
1694 (if (and (> (length line) 1)
1695 (string-match "^[ \t]*: \\(.+\\)" line))
1696 (match-string 1 line)
1697 line))
1698 (split-string
1699 (buffer-substring
1700 (point) (org-babel-result-end)) "[\r\n]+")
1701 "\n")))
1702 (or (org-babel-number-p result-string) result-string))
1703 ((looking-at org-babel-result-regexp)
1704 (save-excursion (forward-line 1) (org-babel-read-result))))))
1705
1706(defun org-babel-read-table ()
1707 "Read the table at `point' into emacs-lisp."
1708 (mapcar (lambda (row)
1709 (if (and (symbolp row) (equal row 'hline)) row
3ab2c837 1710 (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
86fbb8ca
CD		 1711 (org-table-to-lisp)))
1712
acedf35c
CD		 1713(defun org-babel-read-list ()
1714 "Read the list at `point' into emacs-lisp."
3ab2c837
BG		 1715 (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
1716 (mapcar #'cadr (cdr (org-list-parse-list)))))
acedf35c 1717
86fbb8ca
CD		 1718(defvar org-link-types-re)
1719(defun org-babel-read-link ()
1720 "Read the link at `point' into emacs-lisp.
1721If the path of the link is a file path it is expanded using
1722`expand-file-name'."
1723 (let* ((case-fold-search t)
1724 (raw (and (looking-at org-bracket-link-regexp)
1725 (org-babel-clean-text-properties (match-string 1))))
1726 (type (and (string-match org-link-types-re raw)
1727 (match-string 1 raw))))
1728 (cond
1729 ((not type) (expand-file-name raw))
1730 ((string= type "file")
1731 (and (string-match "file\\(.*\\):\\(.+\\)" raw)
1732 (expand-file-name (match-string 2 raw))))
1733 (t raw))))
1734
3ab2c837
BG		 1735(defun org-babel-format-result (result &optional sep)
1736 "Format RESULT for writing to file."
1737 (flet ((echo-res (result)
1738 (if (stringp result) result (format "%S" result))))
1739 (if (listp result)
1740 ;; table result
1741 (orgtbl-to-generic
1742 result
1743 (list
1744 :sep (or sep "\t")
1745 :fmt 'echo-res))
1746 ;; scalar result
1747 (echo-res result))))
1748
86fbb8ca
CD		 1749(defun org-babel-insert-result
1750 (result &optional result-params info hash indent lang)
1751 "Insert RESULT into the current buffer.
1752By default RESULT is inserted after the end of the
1753current source block. With optional argument RESULT-PARAMS
1754controls insertion of results in the org-mode file.
1755RESULT-PARAMS can take the following values...
1756
1757replace - (default option) insert results after the source block
1758 replacing any previously inserted results
1759
1760silent -- no results are inserted
1761
1762file ---- the results are interpreted as a file path, and are
1763 inserted into the buffer using the Org-mode file syntax
1764
acedf35c
CD		 1765list ---- the results are interpreted as an Org-mode list.
1766
1767raw ----- results are added directly to the Org-mode file. This
86fbb8ca
CD		 1768 is a good option if you code block will output org-mode
1769 formatted text.
1770
e66ba1df
BG		 1771wrap ---- results are added directly to the Org-mode file as with
1772 \"raw\", but are wrapped in a RESULTS drawer, allowing
1773 them to later be replaced or removed automatically.
1774
afe98dfa
CD		 1775org ----- similar in effect to raw, only the results are wrapped
1776 in an org code block. Similar to the raw option, on
1777 export the results will be interpreted as org-formatted
1778 text, however by wrapping the results in an org code
1779 block they can be replaced upon re-execution of the
1780 code block.
86fbb8ca
CD		 1781
1782html ---- results are added inside of a #+BEGIN_HTML block. This
1783 is a good option if you code block will output html
1784 formatted text.
1785
1786latex --- results are added inside of a #+BEGIN_LATEX block.
1787 This is a good option if you code block will output
1788 latex formatted text.
1789
1790code ---- the results are extracted in the syntax of the source
1791 code of the language being evaluated and are added
1792 inside of a #+BEGIN_SRC block with the source-code
1793 language set appropriately. Note this relies on the
1794 optional LANG argument."
1795 (if (stringp result)
1796 (progn
1797 (setq result (org-babel-clean-text-properties result))
1798 (when (member "file" result-params)
1799 (setq result (org-babel-result-to-file result))))
1800 (unless (listp result) (setq result (format "%S" result))))
afe98dfa
CD		 1801 (if (and result-params (member "silent" result-params))
1802 (progn
1803 (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
1804 result)
afe98dfa 1805 (save-excursion
3ab2c837
BG		 1806 (let* ((inlinep
1807 (save-excursion
e66ba1df
BG		 1808 (when (or (org-babel-get-inline-src-block-matches)
1809 (org-babel-get-lob-one-liner-matches))
3ab2c837
BG		 1810 (goto-char (match-end 0))
1811 (insert (if (listp result) "\n" " "))
1812 (point))))
1813 (existing-result (unless inlinep
1814 (org-babel-where-is-src-block-result
1815 t info hash indent)))
1816 (results-switches
1817 (cdr (assoc :results_switches (nth 2 info))))
1818 beg end)
1819 (when (and (stringp result) ; ensure results end in a newline
1820 (not inlinep)
1821 (> (length result) 0)
1822 (not (or (string-equal (substring result -1) "\n")
1823 (string-equal (substring result -1) "\r"))))
1824 (setq result (concat result "\n")))
afe98dfa 1825 (if (not existing-result)
3ab2c837 1826 (setq beg (or inlinep (point)))
afe98dfa
CD		 1827 (goto-char existing-result)
1828 (save-excursion
1829 (re-search-forward "#" nil t)
1830 (setq indent (- (current-column) 1)))
1831 (forward-line 1)
1832 (setq beg (point))
86fbb8ca 1833 (cond
afe98dfa
CD		 1834 ((member "replace" result-params)
1835 (delete-region (point) (org-babel-result-end)))
1836 ((member "append" result-params)
acedf35c
CD		 1837 (goto-char (org-babel-result-end)) (setq beg (point-marker)))
1838 ((member "prepend" result-params)))) ; already there
afe98dfa
CD		 1839 (setq results-switches
1840 (if results-switches (concat " " results-switches) ""))
acedf35c 1841 (flet ((wrap (start finish)
3ab2c837 1842 (goto-char end) (insert (concat finish "\n"))
153ae947
BG		 1843 (goto-char beg) (insert (concat start "\n"))
1844 (goto-char end) (goto-char (point-at-eol))
e66ba1df
BG		 1845 (setq end (point-marker)))
1846 (proper-list-p (it) (and (listp it) (null (cdr (last it))))))
1847 ;; insert results based on type
1848 (cond
1849 ;; do nothing for an empty result
1850 ((null result))
1851 ;; insert a list if preferred
1852 ((member "list" result-params)
1853 (insert
1854 (org-babel-trim
1855 (org-list-to-generic
1856 (cons 'unordered
1857 (mapcar
1858 (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
1859 (if (listp result) result (list result))))
1860 '(:splicep nil :istart "- " :iend "\n")))
1861 "\n"))
1862 ;; assume the result is a table if it's not a string
1863 ((proper-list-p result)
1864 (goto-char beg)
1865 (insert (concat (orgtbl-to-orgtbl
1866 (if (or (eq 'hline (car result))
1867 (and (listp (car result))
1868 (listp (cdr (car result)))))
1869 result (list result))
1870 '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
1871 (goto-char beg) (when (org-at-table-p) (org-table-align)))
1872 ((and (listp result) (not (proper-list-p result)))
1873 (insert (format "%s\n" result)))
1874 ((member "file" result-params)
1875 (when inlinep (goto-char inlinep))
1876 (insert result))
1877 (t (goto-char beg) (insert result)))
1878 (when (proper-list-p result) (goto-char (org-table-end)))
1879 (setq end (point-marker))
1880 ;; possibly wrap result
acedf35c
CD		 1881 (cond
1882 ((member "html" result-params)
3ab2c837 1883 (wrap "#+BEGIN_HTML" "#+END_HTML"))
acedf35c 1884 ((member "latex" result-params)
3ab2c837 1885 (wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
acedf35c 1886 ((member "code" result-params)
3ab2c837 1887 (wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
acedf35c
CD		 1888 "#+END_SRC"))
1889 ((member "org" result-params)
3ab2c837 1890 (wrap "#+BEGIN_ORG" "#+END_ORG"))
acedf35c
CD		 1891 ((member "raw" result-params)
1892 (goto-char beg) (if (org-at-table-p) (org-cycle)))
1893 ((member "wrap" result-params)
e66ba1df
BG		 1894 (wrap ":RESULTS:" ":END:"))
1895 ((and (not (proper-list-p result))
1896 (not (member "file" result-params)))
acedf35c
CD		 1897 (org-babel-examplize-region beg end results-switches)
1898 (setq end (point)))))
afe98dfa 1899 ;; possibly indent the results to match the #+results line
3ab2c837 1900 (when (and (not inlinep) (numberp indent) indent (> indent 0)
afe98dfa
CD		 1901 ;; in this case `table-align' does the work for us
1902 (not (and (listp result)
1903 (member "append" result-params))))
1904 (indent-rigidly beg end indent))))
e66ba1df 1905 (if (null result)
afe98dfa 1906 (if (member "value" result-params)
acedf35c
CD		 1907 (message "Code block returned no value.")
1908 (message "Code block produced no output."))
1909 (message "Code block evaluation complete."))))
86fbb8ca
CD		 1910
1911(defun org-babel-remove-result (&optional info)
1912 "Remove the result of the current source block."
1913 (interactive)
1914 (let ((location (org-babel-where-is-src-block-result nil info)) start)
1915 (when location
e66ba1df 1916 (setq start (- location 1))
86fbb8ca 1917 (save-excursion
e66ba1df 1918 (goto-char location) (forward-line 1)
86fbb8ca
CD		 1919 (delete-region start (org-babel-result-end))))))
1920
1921(defun org-babel-result-end ()
1922 "Return the point at the end of the current set of results"
1923 (save-excursion
acedf35c
CD		 1924 (cond
1925 ((org-at-table-p) (progn (goto-char (org-table-end)) (point)))
3ab2c837
BG		 1926 ((org-at-item-p) (let* ((struct (org-list-struct))
1927 (prvs (org-list-prevs-alist struct)))
1928 (org-list-get-list-end (point-at-bol) struct prvs)))
e66ba1df 1929 ((looking-at "^\\([ \t]*\\):RESULTS:")
153ae947
BG		 1930 (progn (re-search-forward (concat "^" (match-string 1) ":END:"))
1931 (forward-char 1) (point)))
acedf35c
CD		 1932 (t
1933 (let ((case-fold-search t)
1934 (blocks-re (regexp-opt
3ab2c837 1935 (list "latex" "html" "example" "src" "result" "org"))))
acedf35c 1936 (if (looking-at (concat "[ \t]*#\\+begin_" blocks-re))
3ab2c837
BG		 1937 (progn (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t)
1938 (forward-char 1))
acedf35c
CD		 1939 (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
1940 (forward-line 1))))
1941 (point)))))
86fbb8ca
CD		 1942
1943(defun org-babel-result-to-file (result)
1944 "Convert RESULT into an `org-mode' link.
1945If the `default-directory' is different from the containing
1946file's directory then expand relative links."
3ab2c837
BG		 1947 (flet ((cond-exp (file)
1948 (if (and default-directory
1949 buffer-file-name
1950 (not (string= (expand-file-name default-directory)
1951 (expand-file-name
1952 (file-name-directory buffer-file-name)))))
1953 (expand-file-name file default-directory)
1954 file)))
1955 (if (stringp result)
1956 (format "[[file:%s]]" (cond-exp result))
1957 (when (and (listp result) (= 2 (length result))
1958 (stringp (car result)) (stringp (cadr result)))
1959 (format "[[file:%s][%s]]" (car result) (cadr result))))))
86fbb8ca 1960
2a88ee23
BG		 1961(defvar org-babel-capitalize-examplize-region-markers nil
1962 "Make true to capitalize begin/end example markers inserted by code blocks.")
1963
86fbb8ca 1964(defun org-babel-examplize-region (beg end &optional results-switches)
3ab2c837 1965 "Comment out region using the inline '==' or ': ' org example quote."
86fbb8ca 1966 (interactive "*r")
153ae947 1967 (flet ((chars-between (b e)
2a88ee23
BG		 1968 (not (string-match "^[\\s]*$" (buffer-substring b e))))
1969 (maybe-cap (str) (if org-babel-capitalize-examplize-region-markers
1970 (upcase str) str)))
3ab2c837
BG		 1971 (if (or (chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
1972 (chars-between end (save-excursion (goto-char end) (point-at-eol))))
1973 (save-excursion
1974 (goto-char beg)
1975 (insert (format "=%s=" (prog1 (buffer-substring beg end)
1976 (delete-region beg end)))))
1977 (let ((size (count-lines beg end)))
1978 (save-excursion
1979 (cond ((= size 0)) ; do nothing for an empty result
1980 ((< size org-babel-min-lines-for-block-output)
1981 (goto-char beg)
1982 (dotimes (n size)
1983 (beginning-of-line 1) (insert ": ") (forward-line 1)))
1984 (t
1985 (goto-char beg)
1986 (insert (if results-switches
2a88ee23
BG		 1987 (format "%s%s\n"
1988 (maybe-cap "#+begin_example")
1989 results-switches)
1990 (maybe-cap "#+begin_example\n")))
3ab2c837 1991 (if (markerp end) (goto-char end) (forward-char (- end beg)))
2a88ee23 1992 (insert (maybe-cap "#+end_example\n")))))))))
86fbb8ca 1993
afe98dfa
CD		 1994(defun org-babel-update-block-body (new-body)
1995 "Update the body of the current code block to NEW-BODY."
1996 (if (not (org-babel-where-is-src-block-head))
1997 (error "not in source block")
1998 (save-match-data
3ab2c837 1999 (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
afe98dfa
CD		 2000 (indent-rigidly (match-beginning 5) (match-end 5) 2)))
2001
86fbb8ca
CD		 2002(defun org-babel-merge-params (&rest plists)
2003 "Combine all parameter association lists in PLISTS.
3ab2c837 2004Later elements of PLISTS override the values of previous elements.
86fbb8ca
CD		 2005This takes into account some special considerations for certain
2006parameters when merging lists."
2007 (let ((results-exclusive-groups
e66ba1df
BG		 2008 (mapcar (lambda (group) (mapcar #'symbol-name group))
2009 (cdr (assoc 'results org-babel-common-header-args-w-values))))
86fbb8ca 2010 (exports-exclusive-groups
e66ba1df
BG		 2011 (mapcar (lambda (group) (mapcar #'symbol-name group))
2012 (cdr (assoc 'exports org-babel-common-header-args-w-values))))
3ab2c837
BG		 2013 (variable-index 0)
2014 params results exports tangle noweb cache vars shebang comments padline)
86fbb8ca
CD		 2015 (flet ((e-merge (exclusive-groups &rest result-params)
2016 ;; maintain exclusivity of mutually exclusive parameters
2017 (let (output)
2018 (mapc (lambda (new-params)
2019 (mapc (lambda (new-param)
2020 (mapc (lambda (exclusive-group)
2021 (when (member new-param exclusive-group)
2022 (mapcar (lambda (excluded-param)
2023 (setq output
2024 (delete
2025 excluded-param
2026 output)))
2027 exclusive-group)))
2028 exclusive-groups)
2029 (setq output (org-uniquify
2030 (cons new-param output))))
2031 new-params))
2032 result-params)
2033 output)))
afe98dfa
CD		 2034 (mapc
2035 (lambda (plist)
2036 (mapc
2037 (lambda (pair)
2038 (case (car pair)
2039 (:var
2040 (let ((name (if (listp (cdr pair))
2041 (cadr pair)
2042 (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
2043 (cdr pair))
2044 (intern (match-string 1 (cdr pair)))))))
3ab2c837
BG		 2045 (if name
2046 (setq vars
2047 (append
2048 (if (member name (mapcar #'car vars))
2049 (delq nil
2050 (mapcar
2051 (lambda (p)
2052 (unless (equal (car p) name) p))
2053 vars))
2054 vars)
2055 (list (cons name pair))))
e66ba1df
BG		 2056 ;; if no name is given and we already have named variables
2057 ;; then assign to named variables in order
2058 (if (and vars (nth variable-index vars))
2059 (prog1 (setf (cddr (nth variable-index vars))
2060 (concat (symbol-name
2061 (car (nth variable-index vars)))
2062 "=" (cdr pair)))
2063 (incf variable-index))
2064 (error "variable \"%s\" must be assigned a default value"
2065 (cdr pair))))))
afe98dfa
CD		 2066 (:results
2067 (setq results (e-merge results-exclusive-groups
3ab2c837
BG		 2068 results
2069 (split-string
2070 (let ((r (cdr pair)))
2071 (if (stringp r) r (eval r)))))))
afe98dfa
CD		 2072 (:file
2073 (when (cdr pair)
2074 (setq results (e-merge results-exclusive-groups
2075 results '("file")))
2076 (unless (or (member "both" exports)
2077 (member "none" exports)
2078 (member "code" exports))
2079 (setq exports (e-merge exports-exclusive-groups
2080 exports '("results"))))
2081 (setq params (cons pair (assq-delete-all (car pair) params)))))
2082 (:exports
2083 (setq exports (e-merge exports-exclusive-groups
2084 exports (split-string (cdr pair)))))
2085 (:tangle ;; take the latest -- always overwrite
2086 (setq tangle (or (list (cdr pair)) tangle)))
2087 (:noweb
acedf35c 2088 (setq noweb (e-merge '(("yes" "no" "tangle")) noweb
afe98dfa
CD		 2089 (split-string (or (cdr pair) "")))))
2090 (:cache
2091 (setq cache (e-merge '(("yes" "no")) cache
2092 (split-string (or (cdr pair) "")))))
3ab2c837
BG		 2093 (:padline
2094 (setq padline (e-merge '(("yes" "no")) padline
2095 (split-string (or (cdr pair) "")))))
afe98dfa
CD		 2096 (:shebang ;; take the latest -- always overwrite
2097 (setq shebang (or (list (cdr pair)) shebang)))
2098 (:comments
2099 (setq comments (e-merge '(("yes" "no")) comments
2100 (split-string (or (cdr pair) "")))))
2101 (t ;; replace: this covers e.g. :session
2102 (setq params (cons pair (assq-delete-all (car pair) params))))))
2103 plist))
2104 plists))
3ab2c837 2105 (setq vars (reverse vars))
afe98dfa 2106 (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
3ab2c837
BG		 2107 (mapc
2108 (lambda (hd)
2109 (let ((key (intern (concat ":" (symbol-name hd))))
2110 (val (eval hd)))
2111 (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
2112 '(results exports tangle noweb padline cache shebang comments))
2113 params))
86fbb8ca 2114
e66ba1df
BG		 2115(defvar *org-babel-use-quick-and-dirty-noweb-expansion* nil
2116 "Set to true to use regular expressions to expand noweb references.
2117This results in much faster noweb reference expansion but does
2118not properly allow code blocks to inherit the \":noweb-ref\"
2119header argument from buffer or subtree wide properties.")
2120
86fbb8ca
CD		 2121(defun org-babel-expand-noweb-references (&optional info parent-buffer)
2122 "Expand Noweb references in the body of the current source code block.
2123
2124For example the following reference would be replaced with the
2125body of the source-code block named 'example-block'.
2126
2127<<example-block>>
2128
2129Note that any text preceding the <<foo>> construct on a line will
2130be interposed between the lines of the replacement text. So for
2131example if <<foo>> is placed behind a comment, then the entire
2132replacement text will also be commented.
2133
2134This function must be called from inside of the buffer containing
2135the source-code block which holds BODY.
2136
2137In addition the following syntax can be used to insert the
2138results of evaluating the source-code block named 'example-block'.
2139
2140<<example-block()>>
2141
2142Any optional arguments can be passed to example-block by placing
2143the arguments inside the parenthesis following the convention
2144defined by `org-babel-lob'. For example
2145
2146<<example-block(a=9)>>
2147
2148would set the value of argument \"a\" equal to \"9\". Note that
2149these arguments are not evaluated in the current source-code
2150block but are passed literally to the \"example-block\"."
2151 (let* ((parent-buffer (or parent-buffer (current-buffer)))
2152 (info (or info (org-babel-get-src-block-info)))
2153 (lang (nth 0 info))
2154 (body (nth 1 info))
3ab2c837 2155 (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
e66ba1df
BG		 2156 (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
2157 ":noweb-ref[ \t]+" "\\)"))
3ab2c837
BG		 2158 (new-body "") index source-name evaluate prefix blocks-in-buffer)
2159 (flet ((nb-add (text) (setq new-body (concat new-body text)))
2160 (c-wrap (text)
2161 (with-temp-buffer
2162 (funcall (intern (concat lang "-mode")))
2163 (comment-region (point) (progn (insert text) (point)))
e66ba1df 2164 (org-babel-trim (buffer-string)))))
86fbb8ca
CD		 2165 (with-temp-buffer
2166 (insert body) (goto-char (point-min))
2167 (setq index (point))
153ae947
BG		 2168 (while (and (re-search-forward "<<\\([^ \t\n].+?[^ \t\n]\\|[^ \t\n]\\)>>"
2169 nil t))
86fbb8ca
CD		 2170 (save-match-data (setf source-name (match-string 1)))
2171 (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
2172 (save-match-data
2173 (setq prefix
2174 (buffer-substring (match-beginning 0)
2175 (save-excursion
2176 (beginning-of-line 1) (point)))))
2177 ;; add interval to new-body (removing noweb reference)
2178 (goto-char (match-beginning 0))
2179 (nb-add (buffer-substring index (point)))
2180 (goto-char (match-end 0))
2181 (setq index (point))
3ab2c837
BG		 2182 (nb-add
2183 (with-current-buffer parent-buffer
153ae947
BG		 2184 (save-restriction
2185 (widen)
3ab2c837
BG		 2186 (mapconcat ;; interpose PREFIX between every line
2187 #'identity
2188 (split-string
2189 (if evaluate
2190 (let ((raw (org-babel-ref-resolve source-name)))
2191 (if (stringp raw) raw (format "%S" raw)))
2192 (or
2193 ;; retrieve from the library of babel
2194 (nth 2 (assoc (intern source-name)
2195 org-babel-library-of-babel))
2196 ;; return the contents of headlines literally
2197 (save-excursion
2198 (when (org-babel-ref-goto-headline-id source-name)
2199 (org-babel-ref-headline-body)))
2200 ;; find the expansion of reference in this buffer
153ae947 2201 (let ((rx (concat rx-prefix source-name "[ \t\n]"))
e66ba1df
BG		 2202 expansion)
2203 (save-excursion
2204 (goto-char (point-min))
2205 (if *org-babel-use-quick-and-dirty-noweb-expansion*
2206 (while (re-search-forward rx nil t)
2207 (let* ((i (org-babel-get-src-block-info 'light))
d660637a 2208 (body (org-babel-expand-noweb-references i))
153ae947
BG		 2209 (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
2210 "\n"))
d660637a
BG		 2211 (full (if comment
2212 ((lambda (cs)
2213 (concat (c-wrap (car cs)) "\n"
2214 body "\n"
2215 (c-wrap (cadr cs))))
2216 (org-babel-tangle-comment-links i))
2217 body)))
153ae947 2218 (setq expansion (cons sep (cons full expansion)))))
e66ba1df
BG		 2219 (org-babel-map-src-blocks nil
2220 (let ((i (org-babel-get-src-block-info 'light)))
2221 (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
2222 (nth 4 i))
2223 source-name)
d660637a 2224 (let* ((body (org-babel-expand-noweb-references i))
153ae947
BG		 2225 (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
2226 "\n"))
d660637a
BG		 2227 (full (if comment
2228 ((lambda (cs)
2229 (concat (c-wrap (car cs)) "\n"
2230 body "\n"
2231 (c-wrap (cadr cs))))
2232 (org-babel-tangle-comment-links i))
2233 body)))
153ae947
BG		 2234 (setq expansion
2235 (cons sep (cons full expansion)))))))))
2236 (and expansion
2237 (mapconcat #'identity (nreverse (cdr expansion)) "")))
3ab2c837
BG		 2238 ;; possibly raise an error if named block doesn't exist
2239 (if (member lang org-babel-noweb-error-langs)
2240 (error "%s" (concat
2241 "<<" source-name ">> "
2242 "could not be resolved (see "
2243 "`org-babel-noweb-error-langs')"))
2244 "")))
153ae947 2245 "[\n\r]") (concat "\n" prefix))))))
86fbb8ca
CD		 2246 (nb-add (buffer-substring index (point-max)))))
2247 new-body))
2248
2249(defun org-babel-clean-text-properties (text)
2250 "Strip all properties from text return."
2251 (when text
2252 (set-text-properties 0 (length text) nil text) text))
2253
153ae947 2254(defun org-babel-strip-protective-commas (body &optional lang)
86fbb8ca 2255 "Strip protective commas from bodies of source blocks."
153ae947
BG		 2256 (with-temp-buffer
2257 (insert body)
2258 (if (and lang (string= lang "org"))
2259 (progn (goto-char (point-min))
2260 (while (re-search-forward "^[ \t]*\\(,\\)" nil t)
2261 (replace-match "" nil nil nil 1)))
2262 (org-strip-protective-commas (point-min) (point-max)))
2263 (buffer-string)))
86fbb8ca 2264
3ab2c837 2265(defun org-babel-script-escape (str &optional force)
acedf35c
CD		 2266 "Safely convert tables into elisp lists."
2267 (let (in-single in-double out)
3ab2c837
BG		 2268 ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped)))
2269 (if (or force
2270 (and (stringp str)
2271 (> (length str) 2)
2272 (or (and (string-equal "[" (substring str 0 1))
2273 (string-equal "]" (substring str -1)))
2274 (and (string-equal "{" (substring str 0 1))
2275 (string-equal "}" (substring str -1)))
2276 (and (string-equal "(" (substring str 0 1))
2277 (string-equal ")" (substring str -1))))))
acedf35c
CD		 2278 (org-babel-read
2279 (concat
2280 "'"
2281 (progn
2282 (mapc
2283 (lambda (ch)
2284 (setq
2285 out
2286 (case ch
2287 (91 (if (or in-double in-single) ; [
2288 (cons 91 out)
2289 (cons 40 out)))
2290 (93 (if (or in-double in-single) ; ]
2291 (cons 93 out)
2292 (cons 41 out)))
3ab2c837
BG		 2293 (123 (if (or in-double in-single) ; {
2294 (cons 123 out)
2295 (cons 40 out)))
2296 (125 (if (or in-double in-single) ; }
2297 (cons 125 out)
2298 (cons 41 out)))
2299 (44 (if (or in-double in-single) ; ,
2300 (cons 44 out) (cons 32 out)))
acedf35c
CD		 2301 (39 (if in-double ; '
2302 (cons 39 out)
2303 (setq in-single (not in-single)) (cons 34 out)))
2304 (34 (if in-single ; "
2305 (append (list 34 32) out)
2306 (setq in-double (not in-double)) (cons 34 out)))
2307 (t (cons ch out)))))
2308 (string-to-list str))
2309 (apply #'string (reverse out)))))
2310 str))))
2311
3ab2c837 2312(defun org-babel-read (cell &optional inhibit-lisp-eval)
86fbb8ca
CD		 2313 "Convert the string value of CELL to a number if appropriate.
2314Otherwise if cell looks like lisp (meaning it starts with a
3ab2c837
BG		 2315\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise
2316return it unmodified as a string. Optional argument NO-LISP-EVAL
2317inhibits lisp evaluation for situations in which is it not
2318appropriate."
86fbb8ca
CD		 2319 (if (and (stringp cell) (not (equal cell "")))
2320 (or (org-babel-number-p cell)
3ab2c837
BG		 2321 (if (and (not inhibit-lisp-eval)
2322 (member (substring cell 0 1) '("(" "'" "`" "[")))
86fbb8ca 2323 (eval (read cell))
3ab2c837
BG		 2324 (if (string= (substring cell 0 1) "\"")
2325 (read cell)
2326 (progn (set-text-properties 0 (length cell) nil cell) cell))))
86fbb8ca
CD		 2327 cell))
2328
2329(defun org-babel-number-p (string)
a98edce9 2330 "If STRING represents a number return its value."
86fbb8ca
CD		 2331 (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string)
2332 (= (length (substring string (match-beginning 0)
2333 (match-end 0)))
2334 (length string)))
2335 (string-to-number string)))
2336
afe98dfa 2337(defun org-babel-import-elisp-from-file (file-name &optional separator)
86fbb8ca
CD		 2338 "Read the results located at FILE-NAME into an elisp table.
2339If the table is trivial, then return it as a scalar."
2340 (let (result)
2341 (save-window-excursion
2342 (with-temp-buffer
2343 (condition-case nil
2344 (progn
afe98dfa 2345 (org-table-import file-name separator)
86fbb8ca
CD		 2346 (delete-file file-name)
2347 (setq result (mapcar (lambda (row)
2348 (mapcar #'org-babel-string-read row))
2349 (org-table-to-lisp))))
2350 (error nil)))
2351 (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
2352 (if (consp (car result))
2353 (if (null (cdr (car result)))
2354 (caar result)
2355 result)
2356 (car result))
2357 result))))
2358
2359(defun org-babel-string-read (cell)
2360 "Strip nested \"s from around strings."
2361 (org-babel-read (or (and (stringp cell)
2362 (string-match "\\\"\\(.+\\)\\\"" cell)
2363 (match-string 1 cell))
2364 cell)))
2365
2366(defun org-babel-reverse-string (string)
2367 "Return the reverse of STRING."
2368 (apply 'string (reverse (string-to-list string))))
2369
2370(defun org-babel-chomp (string &optional regexp)
2371 "Strip trailing spaces and carriage returns from STRING.
2372Default regexp used is \"[ \f\t\n\r\v]\" but can be
2373overwritten by specifying a regexp as a second argument."
2374 (let ((regexp (or regexp "[ \f\t\n\r\v]")))
2375 (while (and (> (length string) 0)
2376 (string-match regexp (substring string -1)))
2377 (setq string (substring string 0 -1)))
2378 string))
2379
2380(defun org-babel-trim (string &optional regexp)
2381 "Strip leading and trailing spaces and carriage returns from STRING.
2382Like `org-babel-chomp' only it runs on both the front and back
2383of the string."
2384 (org-babel-chomp (org-babel-reverse-string
2385 (org-babel-chomp (org-babel-reverse-string string) regexp))
2386 regexp))
2387
2388(defvar org-babel-org-babel-call-process-region-original nil)
2389(defun org-babel-tramp-handle-call-process-region
2390 (start end program &optional delete buffer display &rest args)
2391 "Use tramp to handle call-process-region.
2392Fixes a bug in `tramp-handle-call-process-region'."
2393 (if (and (featurep 'tramp) (file-remote-p default-directory))
2394 (let ((tmpfile (tramp-compat-make-temp-file "")))
2395 (write-region start end tmpfile)
2396 (when delete (delete-region start end))
2397 (unwind-protect
2398 ;; (apply 'call-process program tmpfile buffer display args)
2399 ;; bug in tramp
2400 (apply 'process-file program tmpfile buffer display args)
2401 (delete-file tmpfile)))
afe98dfa
CD		 2402 ;; org-babel-call-process-region-original is the original emacs
2403 ;; definition. It is in scope from the let binding in
2404 ;; org-babel-execute-src-block
86fbb8ca
CD		 2405 (apply org-babel-call-process-region-original
2406 start end program delete buffer display args)))
2407
afe98dfa
CD		 2408(defun org-babel-local-file-name (file)
2409 "Return the local name component of FILE."
2410 (if (file-remote-p file)
2411 (let (localname)
2412 (with-parsed-tramp-file-name file nil
2413 localname))
86fbb8ca
CD		 2414 file))
2415
afe98dfa
CD		 2416(defun org-babel-process-file-name (name &optional no-quote-p)
2417 "Prepare NAME to be used in an external process.
2418If NAME specifies a remote location, the remote portion of the
2419name is removed, since in that case the process will be executing
2420remotely. The file name is then processed by
2421`expand-file-name'. Unless second argument NO-QUOTE-P is non-nil,
2422the file name is additionally processed by
2423`shell-quote-argument'"
2424 ((lambda (f) (if no-quote-p f (shell-quote-argument f)))
2425 (expand-file-name (org-babel-local-file-name name))))
2426
2427(defvar org-babel-temporary-directory)
2428(unless (or noninteractive (boundp 'org-babel-temporary-directory))
2429 (defvar org-babel-temporary-directory
2430 (or (and (boundp 'org-babel-temporary-directory)
2431 (file-exists-p org-babel-temporary-directory)
2432 org-babel-temporary-directory)
2433 (make-temp-file "babel-" t))
2434 "Directory to hold temporary files created to execute code blocks.
2435Used by `org-babel-temp-file'. This directory will be removed on
2436Emacs shutdown."))
2437
2438(defun org-babel-temp-file (prefix &optional suffix)
2439 "Create a temporary file in the `org-babel-temporary-directory'.
2440Passes PREFIX and SUFFIX directly to `make-temp-file' with the
2441value of `temporary-file-directory' temporarily set to the value
2442of `org-babel-temporary-directory'."
2443 (if (file-remote-p default-directory)
2444 (make-temp-file
2445 (concat (file-remote-p default-directory)
acedf35c 2446 (expand-file-name
afe98dfa
CD		 2447 prefix temporary-file-directory)
2448 nil suffix))
2449 (let ((temporary-file-directory
3ab2c837
BG		 2450 (or (and (boundp 'org-babel-temporary-directory)
2451 (file-exists-p org-babel-temporary-directory)
afe98dfa
CD		 2452 org-babel-temporary-directory)
2453 temporary-file-directory)))
2454 (make-temp-file prefix nil suffix))))
2455
2456(defun org-babel-remove-temporary-directory ()
2457 "Remove `org-babel-temporary-directory' on Emacs shutdown."
2458 (when (and (boundp 'org-babel-temporary-directory)
2459 (file-exists-p org-babel-temporary-directory))
2460 ;; taken from `delete-directory' in files.el
acedf35c
CD		 2461 (condition-case nil
2462 (progn
2463 (mapc (lambda (file)
2464 ;; This test is equivalent to
2465 ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
2466 ;; but more efficient
2467 (if (eq t (car (file-attributes file)))
2468 (delete-directory file)
2469 (delete-file file)))
2470 ;; We do not want to delete "." and "..".
2471 (directory-files org-babel-temporary-directory 'full
2472 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
2473 (delete-directory org-babel-temporary-directory))
2474 (error
2475 (message "Failed to remove temporary Org-babel directory %s"
3ab2c837
BG		 2476 (if (boundp 'org-babel-temporary-directory)
2477 org-babel-temporary-directory
2478 "[directory not defined]"))))))
afe98dfa
CD		 2479
2480(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
2481
86fbb8ca
CD		 2482(provide 'ob)
2483
5b409b39 2484
86fbb8ca
CD		 2485
2486;;; ob.el ends here
Unnamed repository; edit this file 'description' to name the repository.