contrib/babel/lisp/org-babel.el

   1 ;;; org-babel.el --- facilitating communication between programming languages and people
   2
   3 ;; Copyright (C) 2009 Eric Schulte, Dan Davison
   4
   5 ;; Author: Eric Schulte, Dan Davison
   6 ;; Keywords: literate programming, reproducible research
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 0.01
   9
  10 ;;; License:
  11
  12 ;; This program 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, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program 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; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; See org-babel.org in the parent directory for more information
  30
  31 ;;; Code:
  32 (require 'org)
  33
  34 (defun org-babel-execute-src-block-maybe ()
  35   "Detect if this is context for a org-babel src-block and if so
  36 then run `org-babel-execute-src-block'."
  37   (interactive)
  38   (let ((info (org-babel-get-src-block-info)))
  39     (if info (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)))
  40
  41 (add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe)
  42
  43 (defadvice org-edit-special (around org-babel-prep-session-for-edit activate)
  44   "Prepare the current source block's session according to it's
  45 header arguments before editing in an org-src buffer.  This
  46 function is called when `org-edit-special' is called with a
  47 prefix argument from inside of a source-code block."
  48   (when current-prefix-arg
  49     (let* ((info (org-babel-get-src-block-info))
  50            (lang (first info))
  51            (params (third info))
  52            (session (cdr (assoc :session params))))
  53       (when (and info session) ;; if we are in a source-code block which has a session
  54         (funcall (intern (concat "org-babel-prep-session:" lang)) session params))))
  55   ad-do-it)
  56
  57 (defadvice org-open-at-point (around org-babel-open-at-point activate)
  58   "If `point' is on a source code block, then open that block's
  59 results with `org-babel-open-src-block-results', otherwise defer
  60 to `org-open-at-point'."
  61   (interactive "P")
  62   (or (call-interactively #'org-babel-open-src-block-result) ad-do-it))
  63
  64 (defun org-babel-load-in-session-maybe ()
  65   "Detect if this is context for a org-babel src-block and if so
  66 then run `org-babel-load-in-session'."
  67   (interactive)
  68   (let ((info (org-babel-get-src-block-info)))
  69     (if info (progn (org-babel-load-in-session current-prefix-arg info) t) nil)))
  70
  71 (add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
  72
  73 (defun org-babel-pop-to-session-maybe ()
  74   "Detect if this is context for a org-babel src-block and if so
  75 then run `org-babel-pop-to-session'."
  76   (interactive)
  77   (let ((info (org-babel-get-src-block-info)))
  78     (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
  79
  80 (add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
  81
  82 (defvar org-babel-default-header-args
  83   '((:session . "none") (:results . "replace") (:exports . "code") (:nocache) (:noweb . "no"))
  84   "Default arguments to use when evaluating a source block.")
  85
  86 (defvar org-babel-default-inline-header-args
  87   '((:session . "none") (:results . "silent") (:exports . "results"))
  88   "Default arguments to use when evaluating an inline source block.")
  89
  90 (defvar org-babel-src-block-regexp nil
  91   "Regexp used to test when inside of a org-babel src-block")
  92
  93 (defvar org-babel-inline-src-block-regexp nil
  94   "Regexp used to test when on an inline org-babel src-block")
  95
  96 (defvar org-babel-result-regexp
  97   "#\\+res\\(ults\\|name\\)\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:"
  98   "Regular expression used to match result lines.  If the
  99 results are associated with a hash key then the hash will be
 100 saved in the second match data.")
 101
 102 (defvar org-babel-source-name-regexp
 103   "#\\+\\(srcname\\|source\\|function\\):[ \t]*"
 104   "Regular expression used to match a source name line.")
 105
 106 (defvar org-babel-min-lines-for-block-output 10
 107   "If number of lines of output is equal to or exceeds this
 108 value, the output is placed in a #+begin_example...#+end_example
 109 block. Otherwise the output is marked as literal by inserting
 110 colons at the starts of the lines. This variable only takes
 111 effect if the :results output option is in effect.")
 112
 113 (defvar org-babel-noweb-error-langs nil
 114   "List of language for which errors should be raised when the
 115 source code block satisfying a noweb reference in this language
 116 can not be resolved.")
 117
 118 (defvar org-babel-hash-show 4
 119   "Number of initial characters to show of a hidden results hash.")
 120
 121 (defun org-babel-named-src-block-regexp-for-name (name)
 122   "Regexp used to match named src block."
 123   (concat org-babel-source-name-regexp (regexp-quote name) "[ \t\n]*"
 124           (substring org-babel-src-block-regexp 1)))
 125
 126 (defun org-babel-set-interpreters (var value)
 127   (set-default var value)
 128   (setq org-babel-src-block-regexp
 129         (concat "^[ \t]*#\\+begin_src[ \t]+\\("       ;; (1)   lang
 130                 (mapconcat 'regexp-quote value "\\|")
 131                 "\\)[ \t]*"
 132                 "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" ;; (2)   switches
 133                 "\\([^\n]*\\)\n"                      ;; (3)   header arguments
 134                 "\\([^\000]+?\\)#\\+end_src"))        ;; (4)   body
 135   (setq org-babel-inline-src-block-regexp
 136         (concat "[ \f\t\n\r\v]\\(src_"                ;; (1)   replacement target
 137                 "\\("                                 ;; (2)   lang
 138                 (mapconcat 'regexp-quote value "\\|")
 139                 "\\)"
 140                 "\\(\\|\\[\\(.*\\)\\]\\)"             ;; (3,4) (unused, headers)
 141                 "{\\([^\f\n\r\v]+\\)}"                ;; (5)   body
 142                 "\\)")))
 143
 144 (defun org-babel-add-interpreter (interpreter)
 145   "Add INTERPRETER to `org-babel-interpreters' and update
 146 `org-babel-src-block-regexp' appropriately."
 147   (unless (member interpreter org-babel-interpreters)
 148     (setq org-babel-interpreters (cons interpreter org-babel-interpreters))
 149     (org-babel-set-interpreters 'org-babel-interpreters org-babel-interpreters)))
 150
 151 (defcustom org-babel-interpreters '()
 152   "Interpreters allows for evaluation tags.
 153 This is a list of program names (as strings) that can evaluate code and
 154 insert the output into an Org-mode buffer.  Valid choices are
 155
 156 R          Evaluate R code
 157 emacs-lisp Evaluate Emacs Lisp code and display the result
 158 sh         Pass command to the shell and display the result
 159 perl       The perl interpreter
 160 python     The python interpreter
 161 ruby       The ruby interpreter
 162
 163 The source block regexp `org-babel-src-block-regexp' is updated
 164 when a new interpreter is added to this list through the
 165 customize interface.  To add interpreters to this variable from
 166 lisp code use the `org-babel-add-interpreter' function."
 167   :group 'org-babel
 168   :set 'org-babel-set-interpreters
 169   :type '(set :greedy t
 170               (const "R")
 171               (const "emacs-lisp")
 172               (const "sh")
 173               (const "perl")
 174               (const "python")
 175               (const "ruby")))
 176
 177 ;;; functions
 178 (defun org-babel-execute-src-block (&optional arg info params)
 179   "Execute the current source code block, and insert the results
 180 into the buffer.  Source code execution and the collection and
 181 formatting of results can be controlled through a variety of
 182 header arguments.
 183
 184 Optionally supply a value for INFO in the form returned by
 185 `org-babel-get-src-block-info'.
 186
 187 Optionally supply a value for PARAMS which will be merged with
 188 the header arguments specified at the front of the source code
 189 block."
 190   (interactive)
 191   ;; (message "supplied params=%S" params) ;; debugging
 192   (let* ((info (or info (org-babel-get-src-block-info)))
 193          (lang (first info))
 194          (params (setf (third info)
 195                        (sort (org-babel-merge-params (third info) params)
 196                              (lambda (el1 el2) (string< (symbol-name (car el1))
 197                                                    (symbol-name (car el2)))))))
 198          (new-hash (unless (assoc :nocache params) (org-babel-sha1-hash info)))
 199          (old-hash (org-babel-result-hash info))
 200          (body (setf (second info)
 201                      (if (and (cdr (assoc :noweb params))
 202                               (string= "yes" (cdr (assoc :noweb params))))
 203                          (org-babel-expand-noweb-references info) (second info))))
 204          (result-params (split-string (or (cdr (assoc :results params)) "")))
 205          (result-type (cond ((member "output" result-params) 'output)
 206                             ((member "value" result-params) 'value)
 207                             (t 'value)))
 208          (cmd (intern (concat "org-babel-execute:" lang)))
 209          result)
 210     ;; (message "params=%S" params) ;; debugging
 211     (unless (member lang org-babel-interpreters)
 212       (error "Language is not in `org-babel-interpreters': %s" lang))
 213     (if (and (not arg) new-hash (equal new-hash old-hash))
 214         (save-excursion ;; return cached result
 215           (goto-char (org-babel-where-is-src-block-result nil info))
 216           (move-end-of-line 1) (forward-char 1)
 217           (setq result (org-babel-read-result))
 218           (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
 219       (setq result (funcall cmd body params))
 220       (if (eq result-type 'value)
 221           (setq result (if (and (or (member "vector" result-params)
 222                                     (member "table" result-params))
 223                                 (not (listp result)))
 224                            (list (list result))
 225                          result)))
 226       (org-babel-insert-result result result-params info new-hash)
 227       result)))
 228
 229 (defun org-babel-load-in-session (&optional arg info)
 230   "Load the body of the current source-code block.  Evaluate the
 231 header arguments for the source block before entering the
 232 session.  After loading the body this pops open the session."
 233   (interactive)
 234   (let* ((info (or info (org-babel-get-src-block-info)))
 235          (lang (first info))
 236          (body (second info))
 237          (params (third info))
 238          (session (cdr (assoc :session params))))
 239     (unless (member lang org-babel-interpreters)
 240       (error "Language is not in `org-babel-interpreters': %s" lang))
 241     ;; if called with a prefix argument, then process header arguments
 242     (pop-to-buffer (funcall (intern (concat "org-babel-load-session:" lang)) session body params))
 243     (move-end-of-line 1)))
 244
 245 (defun org-babel-pop-to-session (&optional arg info)
 246   "Pop to the session of the current source-code block.  If
 247 called with a prefix argument then evaluate the header arguments
 248 for the source block before entering the session.  Copy the body
 249 of the source block to the kill ring."
 250   (interactive)
 251   (let* ((info (or info (org-babel-get-src-block-info)))
 252          (lang (first info))
 253          (body (second info))
 254          (params (third info))
 255          (session (cdr (assoc :session params))))
 256     (unless (member lang org-babel-interpreters)
 257       (error "Language is not in `org-babel-interpreters': %s" lang))
 258     ;; copy body to the kill ring
 259     (with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max)))
 260     ;; if called with a prefix argument, then process header arguments
 261     (if arg (funcall (intern (concat "org-babel-prep-session:" lang)) session params))
 262     ;; just to the session using pop-to-buffer
 263     (pop-to-buffer (funcall (intern (format "org-babel-%s-initiate-session" lang)) session))
 264     (move-end-of-line 1)))
 265
 266 (defun org-babel-open-src-block-result (&optional re-run)
 267   "If `point' is on a src block then open the results of the
 268 source code block, otherwise return nil.  With optional prefix
 269 argument RE-RUN the source-code block is evaluated even if
 270 results already exist."
 271   (interactive "P")
 272   (when (org-babel-get-src-block-info)
 273     (save-excursion
 274       ;; go to the results, if there aren't any then run the block
 275       (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
 276                      (progn (org-babel-execute-src-block)
 277                             (org-babel-where-is-src-block-result))))
 278       (move-end-of-line 1) (forward-char 1)
 279       ;; open the results
 280       (if (looking-at org-bracket-link-regexp)
 281           ;; file results
 282           (org-open-at-point)
 283         (let ((results (org-babel-read-result)))
 284           (flet ((echo-res (result)
 285                            (if (stringp result) result (format "%S" result))))
 286             (pop-to-buffer (get-buffer-create "org-babel-results"))
 287             (delete-region (point-min) (point-max))
 288             (if (listp results)
 289                 ;; table result
 290                 (insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res)))
 291               ;; scalar result
 292               (insert (echo-res results))))))
 293       t)))
 294
 295 (defun org-babel-execute-buffer (&optional arg)
 296   "Replace EVAL snippets in the entire buffer."
 297   (interactive "P")
 298   (save-excursion
 299     (goto-char (point-min))
 300     (while (re-search-forward org-babel-src-block-regexp nil t)
 301       (goto-char (match-beginning 0))
 302       (org-babel-execute-src-block arg)
 303       (goto-char (match-end 0)))))
 304
 305 (defun org-babel-execute-subtree (&optional arg)
 306   "Replace EVAL snippets in the entire subtree."
 307   (interactive "P")
 308   (save-excursion
 309     (org-narrow-to-subtree)
 310     (org-babel-execute-buffer)
 311     (widen)))
 312
 313 (defun org-babel-get-src-block-info (&optional header-vars-only)
 314   "Get information of the current source block.
 315 Returns a list
 316  (language body header-arguments-alist switches name function-args).
 317 Unless HEADER-VARS-ONLY is non-nil, any variable
 318 references provided in 'function call style' (i.e. in a
 319 parenthesised argument list following the src block name) are
 320 added to the header-arguments-alist."
 321   (let ((case-fold-search t) head info args)
 322     (if (setq head (org-babel-where-is-src-block-head))
 323         (save-excursion
 324           (goto-char head)
 325           (setq info (org-babel-parse-src-block-match))
 326           (forward-line -1)
 327           (when (looking-at (concat org-babel-source-name-regexp
 328                                     "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
 329             (setq info (append info (list (org-babel-clean-text-properties (match-string 2)))))
 330             ;; Note that e.g. "name()" and "name( )" result in ((:var . "")).
 331             ;; We maintain that behaviour, and the resulting non-nil sixth
 332             ;; element is relied upon in org-babel-exp-code to detect a functional-style
 333             ;; block in those cases. However, "name" without any
 334             ;; parentheses would result in the same thing, so we
 335             ;; explicitly avoid that.
 336             (if (setq args (match-string 4))
 337                 (setq info (append info (list (mapcar (lambda (ref) (cons :var ref))
 338                                                       (org-babel-ref-split-args args))))))
 339             (unless header-vars-only
 340               (setf (third info)
 341                     (org-babel-merge-params (sixth info) (third info)))))
 342           info)
 343       (if (save-excursion ;; inline source block
 344             (re-search-backward "[ \f\t\n\r\v]" nil t)
 345             (looking-at org-babel-inline-src-block-regexp))
 346           (org-babel-parse-inline-src-block-match)
 347         nil)))) ;; indicate that no source block was found
 348
 349 (defun org-babel-sha1-hash (&optional info)
 350   (interactive)
 351   (let* ((info (or info (org-babel-get-src-block-info)))
 352          (hash (sha1 (format "%s-%s" (mapconcat (lambda (arg) (format "%S" arg))
 353                                                 (third info) ":")
 354                              (second info)))))
 355     (when (interactive-p) (message hash))
 356     hash))
 357
 358 (defun org-babel-result-hash (&optional info)
 359   (org-babel-where-is-src-block-result nil info)
 360   (org-babel-clean-text-properties (match-string 3)))
 361
 362 (defun org-babel-hide-hash ()
 363   "Hide the hash in the current results line.  Only the initial
 364 `org-babel-hash-show' characters of the hash will remain
 365 visible."
 366   (org-add-to-invisibility-spec '(org-babel-hide-hash . t))
 367   (save-excursion
 368     (when (and (re-search-forward org-babel-result-regexp nil t)
 369                (match-string 3))
 370       (let* ((start (match-beginning 3))
 371              (hide-start (+ org-babel-hash-show start))
 372              (end (match-end 3))
 373              (hash (match-string 3))
 374              ov1 ov2)
 375         (setq ov1 (org-make-overlay start hide-start))
 376         (setq ov2 (org-make-overlay hide-start end))
 377         (org-overlay-put ov2 'invisible 'org-babel-hide-hash)
 378         (org-overlay-put ov1 'babel-hash hash)))))
 379
 380 (defun org-babel-hide-all-hashes ()
 381   "Hide the hash in the current buffer.  Only the initial
 382 `org-babel-hash-show' characters of each hash will remain
 383 visible.  This function should be called as part of the
 384 `org-mode-hook'."
 385   (save-excursion
 386     (while (re-search-forward org-babel-result-regexp nil t)
 387       (goto-char (match-beginning 0))
 388       (org-babel-hide-hash)
 389       (goto-char (match-end 0)))))
 390 (add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
 391
 392 (defun org-babel-hash-at-point (&optional point)
 393   "Return the value of the hash at `point'.  The hash is also
 394 added as the last element of the kill ring.  This can be called
 395 with C-c C-c."
 396   (interactive)
 397   (let ((hash (car (delq nil (mapcar
 398                                (lambda (ol) (org-overlay-get ol 'babel-hash))
 399                               (org-overlays-at (or point (point))))))))
 400     (when hash (kill-new hash) (message hash))))
 401 (add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
 402
 403 (defun org-babel-result-hide-spec ()
 404   (org-add-to-invisibility-spec '(org-babel-hide-result . t)))
 405 (add-hook 'org-mode-hook 'org-babel-result-hide-spec)
 406
 407 (defvar org-babel-hide-result-overlays nil
 408   "Overlays hiding results.")
 409
 410 (defun org-babel-result-hide-all ()
 411   "Fold all results in the current buffer."
 412   (interactive)
 413   (org-babel-show-result-all)
 414   (save-excursion
 415     (while (re-search-forward org-babel-result-regexp nil t)
 416       (save-excursion (goto-char (match-beginning 0))
 417                       (org-babel-hide-result-toggle-maybe)))))
 418
 419 (defun org-babel-show-result-all ()
 420   "Unfold all results in the current buffer."
 421   (mapc 'org-delete-overlay org-babel-hide-result-overlays)
 422   (setq org-babel-hide-result-overlays nil))
 423
 424 (defun org-babel-hide-result-toggle-maybe ()
 425   "Toggle visibility of result at point."
 426   (interactive)
 427   (let ((case-fold-search t))
 428     (if (save-excursion
 429           (beginning-of-line 1)
 430           (looking-at org-babel-result-regexp))
 431         (progn (org-babel-hide-result-toggle)
 432                t) ;; to signal that we took action
 433       nil))) ;; to signal that we did not
 434
 435 (defun org-babel-hide-result-toggle (&optional force)
 436   "Toggle the visibility of the current result."
 437   (interactive)
 438   (save-excursion
 439     (beginning-of-line)
 440     (if (re-search-forward org-babel-result-regexp nil t)
 441         (let ((start (progn (beginning-of-line 2) (- (point) 1)))
 442               (end (progn (goto-char (- (org-babel-result-end) 1)) (point)))
 443               ov)
 444           (if (memq t (mapcar (lambda (overlay)
 445                                 (eq (org-overlay-get overlay 'invisible)
 446                                     'org-babel-hide-result))
 447                               (org-overlays-at start)))
 448               (if (or (not force) (eq force 'off))
 449                   (mapc (lambda (ov)
 450                           (when (member ov org-babel-hide-result-overlays)
 451                             (setq org-babel-hide-result-overlays
 452                                   (delq ov org-babel-hide-result-overlays)))
 453                           (when (eq (org-overlay-get ov 'invisible)
 454                                     'org-babel-hide-result)
 455                             (org-delete-overlay ov)))
 456                         (org-overlays-at start)))
 457             (setq ov (org-make-overlay start end))
 458             (org-overlay-put ov 'invisible 'org-babel-hide-result)
 459             ;; make the block accessible to isearch
 460             (org-overlay-put
 461              ov 'isearch-open-invisible
 462              (lambda (ov)
 463                (when (member ov org-babel-hide-result-overlays)
 464                  (setq org-babel-hide-result-overlays
 465                        (delq ov org-babel-hide-result-overlays)))
 466                (when (eq (org-overlay-get ov 'invisible)
 467                          'org-babel-hide-result)
 468                  (org-delete-overlay ov))))
 469             (push ov org-babel-hide-result-overlays)))
 470       (error "Not looking at a result line"))))
 471
 472 ;; org-tab-after-check-for-cycling-hook
 473 (add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
 474 ;; Remove overlays when changing major mode
 475 (add-hook 'org-mode-hook
 476           (lambda () (org-add-hook 'change-major-mode-hook
 477                                    'org-babel-show-result-all 'append 'local)))
 478
 479 (defmacro org-babel-map-source-blocks (file &rest body)
 480   "Evaluate BODY forms on each source-block in FILE."
 481   (declare (indent 1))
 482   `(let ((visited-p (get-buffer (file-name-nondirectory ,file))))
 483      (save-window-excursion
 484        (find-file ,file) (goto-char (point-min))
 485        (while (re-search-forward org-babel-src-block-regexp nil t)
 486          (goto-char (match-beginning 0))
 487          (save-match-data ,@body)
 488          (goto-char (match-end 0))))
 489      (unless visited-p (kill-buffer (file-name-nondirectory file)))))
 490
 491 (defun org-babel-params-from-properties ()
 492   "Return an association list of any source block params which
 493 may be specified in the properties of the current outline entry."
 494   (save-match-data
 495     (delq nil
 496           (mapcar
 497            (lambda (header-arg)
 498              (let ((val (or (condition-case nil
 499                                 (org-entry-get (point) header-arg 'selective)
 500                               (error nil))
 501                             (cdr (assoc header-arg org-file-properties)))))
 502                (when val
 503                  ;; (message "param-from-property %s=%s" header-arg val) ;; debugging statement
 504                  (cons (intern (concat ":" header-arg)) val))))
 505            '("exports" "results" "session" "tangle" "var")))))
 506
 507 (defun org-babel-parse-src-block-match ()
 508   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 509          (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
 510          (switches (match-string 2))
 511          (body (org-babel-clean-text-properties (match-string 4)))
 512          (preserve-indentation (or org-src-preserve-indentation
 513                                    (string-match "-i\\>" switches))))
 514     (list lang
 515           ;; get src block body removing properties, protective commas, and indentation
 516           (with-temp-buffer
 517             (save-match-data
 518               (insert (org-babel-strip-protective-commas body))
 519               (unless preserve-indentation (org-do-remove-indentation))
 520               (buffer-string)))
 521           (org-babel-merge-params
 522            org-babel-default-header-args
 523            (org-babel-params-from-properties)
 524            (if (boundp lang-headers) (eval lang-headers) nil)
 525            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) ""))))
 526           switches)))
 527
 528 (defun org-babel-parse-inline-src-block-match ()
 529   (let* ((lang (org-babel-clean-text-properties (match-string 2)))
 530          (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
 531     (list lang
 532           (org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 5)))
 533           (org-babel-merge-params
 534            org-babel-default-inline-header-args
 535            (org-babel-params-from-properties)
 536            (if (boundp lang-headers) (eval lang-headers) nil)
 537            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 4) "")))))))
 538
 539 (defun org-babel-parse-header-arguments (arg-string)
 540   "Parse a string of header arguments returning an alist."
 541   (if (> (length arg-string) 0)
 542       (delq nil
 543             (mapcar
 544              (lambda (arg)
 545                (if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg)
 546                    (cons (intern (concat ":" (match-string 1 arg)))
 547                          (let ((raw (org-babel-chomp (match-string 2 arg))))
 548                            (if (org-babel-number-p raw) raw (eval (org-babel-read raw)))))
 549                  (cons (intern (concat ":" arg)) nil)))
 550              (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
 551
 552 (defun org-babel-process-params (params)
 553   "Parse params and resolve references.
 554
 555 Return a list (session vars result-params result-type)."
 556   (let* ((session (cdr (assoc :session params)))
 557          (vars (org-babel-ref-variables params))
 558          (result-params (split-string (or (cdr (assoc :results params)) "")))
 559          (result-type (cond ((member "output" result-params) 'output)
 560                             ((member "value" result-params) 'value)
 561                             (t 'value))))
 562     (list session vars result-params result-type)))
 563
 564 (defun org-babel-where-is-src-block-head ()
 565   "Return the point at the beginning of the current source
 566 block.  Specifically at the beginning of the #+BEGIN_SRC line.
 567 If the point is not on a source block then return nil."
 568   (let ((initial (point)) top bottom)
 569     (or
 570      (save-excursion ;; on a source name line
 571        (beginning-of-line 1)
 572        (and (looking-at org-babel-source-name-regexp) (forward-line 1)
 573             (looking-at org-babel-src-block-regexp)
 574             (point)))
 575      (save-excursion ;; on a #+begin_src line
 576        (beginning-of-line 1)
 577        (and (looking-at org-babel-src-block-regexp)
 578             (point)))
 579      (save-excursion ;; inside a src block
 580        (and
 581         (re-search-backward "#\\+begin_src" nil t) (setq top (point))
 582         (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
 583         (< top initial) (< initial bottom)
 584         (goto-char top) (move-beginning-of-line 1)
 585         (looking-at org-babel-src-block-regexp)
 586         (point))))))
 587
 588 (defun org-babel-goto-named-source-block (&optional name)
 589   "Go to a named source-code block."
 590   (interactive "ssource-block name: ")
 591   (let ((point (org-babel-find-named-block name)))
 592     (if point
 593         ;; taken from `org-open-at-point'
 594         (progn (goto-char point) (org-show-context))
 595       (message "source-code block '%s' not found in this buffer" name))))
 596
 597 (defun org-babel-find-named-block (name)
 598   "Find a named source-code block.
 599 Return the location of the source block identified by source
 600 NAME, or nil if no such block exists. Set match data according to
 601 org-babel-named-src-block-regexp."
 602   (save-excursion
 603     (let ((case-fold-search t)
 604           (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
 605       (goto-char (point-min))
 606       (when (or (re-search-forward regexp nil t)
 607                 (re-search-backward regexp nil t))
 608         (match-beginning 0)))))
 609
 610 (defun org-babel-find-named-result (name)
 611   "Return the location of the result named NAME in the current
 612 buffer or nil if no such result exists."
 613   (save-excursion
 614     (goto-char (point-min))
 615     (when (re-search-forward
 616            (concat org-babel-result-regexp "[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
 617       (move-beginning-of-line 0) (point))))
 618
 619 (defun org-babel-where-is-src-block-result (&optional insert info hash)
 620   "Return the point at the beginning of the result of the current
 621 source block.  Specifically at the beginning of the results line.
 622 If no result exists for this block then create a results line
 623 following the source block."
 624   (save-excursion
 625     (let* ((on-lob-line (progn (beginning-of-line 1)
 626                                (looking-at org-babel-lob-one-liner-regexp)))
 627            (name (if on-lob-line (first (org-babel-lob-get-info))
 628                    (fifth (or info (org-babel-get-src-block-info)))))
 629            (head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
 630       (when head (goto-char head))
 631       (or (and name (org-babel-find-named-result name))
 632           (and (or on-lob-line (re-search-forward "#\\+end_src" nil t))
 633                (progn (move-end-of-line 1)
 634                       (if (eobp) (insert "\n") (forward-char 1))
 635                       (setq end (point))
 636                       (or (and (not name)
 637                                (progn ;; unnamed results line already exists
 638                                  (re-search-forward "[^ \f\t\n\r\v]" nil t)
 639                                  (move-beginning-of-line 1)
 640                                  (looking-at (concat org-babel-result-regexp "\n"))))
 641                           ;; or (with optional insert) back up and make one ourselves
 642                           (when insert
 643                             (goto-char end)
 644                             (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))
 645                             (insert (concat "#+results" (if hash (concat "["hash"]"))
 646                                             ":"(if name (concat " " name)) "\n"))
 647                             (move-beginning-of-line 0)
 648                             (if hash (org-babel-hide-hash)) t)))
 649                (point))))))
 650
 651 (defun org-babel-read-result ()
 652   "Read the result at `point' into emacs-lisp."
 653   (let ((case-fold-search t) result-string)
 654     (cond
 655      ((org-at-table-p) (org-babel-read-table))
 656      ((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
 657      ((looking-at ": ")
 658       (setq result-string
 659             (org-babel-trim
 660              (mapconcat (lambda (line) (if (and (> (length line) 1)
 661                                                 (string= ": " (substring line 0 2)))
 662                                            (substring line 2)
 663                                          line))
 664                         (split-string
 665                          (buffer-substring (point) (org-babel-result-end)) "[\r\n]+")
 666                         "\n")))
 667       (or (org-babel-number-p result-string) result-string))
 668      ((looking-at org-babel-result-regexp)
 669       (save-excursion (forward-line 1) (org-babel-read-result))))))
 670
 671 (defun org-babel-read-table ()
 672   "Read the table at `point' into emacs-lisp."
 673   (mapcar (lambda (row)
 674             (if (and (symbolp row) (equal row 'hline)) row
 675               (mapcar #'org-babel-read row)))
 676           (org-table-to-lisp)))
 677
 678 (defun org-babel-insert-result (result &optional result-params info hash)
 679   "Insert RESULT into the current buffer after the end of the
 680 current source block.  With optional argument RESULT-PARAMS
 681 controls insertion of results in the org-mode file.
 682 RESULT-PARAMS can take the following values...
 683
 684 replace - (default option) insert results after the source block
 685           replacing any previously inserted results
 686
 687 silent -- no results are inserted
 688
 689 file ---- the results are interpreted as a file path, and are
 690           inserted into the buffer using the Org-mode file syntax
 691
 692 raw ----- results are added directly to the org-mode file.  This
 693           is a good option if you code block will output org-mode
 694           formatted text.
 695
 696 org ----- this is the same as the 'raw' option
 697
 698 html ---- results are added inside of a #+BEGIN_HTML block.  This
 699           is a good option if you code block will output html
 700           formatted text.
 701
 702 latex --- results are added inside of a #+BEGIN_LATEX block.
 703           This is a good option if you code block will output
 704           latex formatted text.
 705
 706 code ---- the results are extracted in the syntax of the source
 707           code of the language being evaluated and are added
 708           inside of a #+BEGIN_SRC block with the source-code
 709           language set appropriately."
 710   (if (stringp result)
 711       (progn
 712         (setq result (org-babel-clean-text-properties result))
 713         (when (member "file" result-params)
 714           (setq result (org-babel-result-to-file result))))
 715     (unless (listp result) (setq result (format "%S" result))))
 716   (if (and result-params (member "replace" result-params)
 717            (not (member "silent" result-params)))
 718       (org-babel-remove-result info))
 719   (if (= (length result) 0)
 720       (if (member "value" result-params)
 721           (message "No result returned by source block")
 722         (message "Source block produced no output"))
 723     (if (and result-params (member "silent" result-params))
 724         (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
 725                result)
 726       (when (and (stringp result) ;; ensure results end in a newline
 727                  (not (or (string-equal (substring result -1) "\n")
 728                           (string-equal (substring result -1) "\r"))))
 729         (setq result (concat result "\n")))
 730       (save-excursion
 731         (let ((existing-result (org-babel-where-is-src-block-result t info hash))
 732               (results-switches (cdr (assoc :results_switches (third info)))))
 733           (when existing-result (goto-char existing-result) (forward-line 1))
 734           (setq results-switches
 735                 (if results-switches (concat " " results-switches) ""))
 736           (cond
 737            ;; assume the result is a table if it's not a string
 738            ((not (stringp result))
 739             (insert (concat (orgtbl-to-orgtbl
 740                              (if (and (listp (car result))
 741                                       (listp (cdr (car result))))
 742                                  result (list result))
 743                              '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
 744             (forward-line -1) (org-cycle))
 745            ((member "file" result-params)
 746             (insert result))
 747            ((member "html" result-params)
 748             (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" results-switches result)))
 749            ((member "latex" result-params)
 750             (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" results-switches result)))
 751            ((member "code" result-params)
 752             (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" lang results-switches result)))
 753            ((or (member "raw" result-params) (member "org" result-params))
 754             (save-excursion (insert result)) (if (org-at-table-p) (org-cycle)))
 755            (t
 756             (org-babel-examplize-region
 757              (point) (progn (insert result) (point)) results-switches)))))
 758       (message "finished"))))
 759
 760 (defun org-babel-result-to-org-string (result)
 761   "Return RESULT as a string in org-mode format.  This function
 762 relies on `org-babel-insert-result'."
 763   (with-temp-buffer (org-babel-insert-result result) (buffer-string)))
 764
 765 (defun org-babel-remove-result (&optional info)
 766   "Remove the result of the current source block."
 767   (interactive)
 768   (let ((location (org-babel-where-is-src-block-result nil info)) start)
 769     (when location
 770       (save-excursion
 771         (goto-char location) (setq start (point)) (forward-line 1)
 772         (delete-region start (org-babel-result-end))))))
 773
 774 (defun org-babel-result-end ()
 775   "Return the point at the end of the current set of results"
 776   (save-excursion
 777     (if (org-at-table-p)
 778         (progn (goto-char (org-table-end)) (point))
 779       (let ((case-fold-search t))
 780         (cond
 781          ((looking-at "#\\+begin_latex")
 782           (search-forward "#+end_latex" nil t)
 783           (forward-line 1))
 784          ((looking-at "#\\+begin_html")
 785           (search-forward "#+end_html" nil t)
 786           (forward-line 1))
 787          ((looking-at "#\\+begin_example")
 788           (search-forward "#+end_example" nil t)
 789           (forward-line 1))
 790          ((looking-at "#\\+begin_src")
 791           (search-forward "#+end_src" nil t)
 792           (forward-line 1))
 793          (t (progn (while (looking-at "\\(: \\|\\[\\[\\)")
 794                      (forward-line 1))))))
 795       (point))))
 796
 797 (defun org-babel-result-to-file (result)
 798   "Return an `org-mode' link with the path being the value or
 799 RESULT, and the display being the `file-name-nondirectory' if
 800 non-nil."
 801   (concat "[[file:" result "]]"))
 802
 803 (defun org-babel-examplize-region (beg end &optional results-switches)
 804   "Comment out region using the ': ' org example quote."
 805   (interactive "*r")
 806   (let ((size (abs (- (line-number-at-pos end)
 807                       (line-number-at-pos beg)))))
 808     (save-excursion
 809       (cond ((= size 0)
 810              (error "This should be impossible: a newline was appended to result if missing"))
 811             ((< size org-babel-min-lines-for-block-output)
 812              (goto-char beg)
 813              (dotimes (n size)
 814                (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
 815             (t
 816              (goto-char beg)
 817              (insert (if results-switches
 818                          (format "#+begin_example%s\n" results-switches)
 819                        "#+begin_example\n"))
 820              (forward-char (- end beg))
 821              (insert "#+end_example\n"))))))
 822
 823 (defun org-babel-merge-params (&rest plists)
 824   "Combine all parameter association lists in PLISTS.  Later
 825 elements of PLISTS override the values of previous element.  This
 826 takes into account some special considerations for certain
 827 parameters when merging lists."
 828   (let ((results-exclusive-groups
 829          '(("file" "vector" "table" "scalar" "raw" "org" "html" "latex" "code" "pp")
 830            ("replace" "silent")
 831            ("output" "value")))
 832         (exports-exclusive-groups
 833          '(("code" "results" "both" "none")))
 834         params results exports tangle noweb cache vars var ref)
 835     (flet ((e-merge (exclusive-groups &rest result-params)
 836                     ;; maintain exclusivity of mutually exclusive parameters
 837                     (let (output)
 838                       (mapc (lambda (new-params)
 839                               (mapc (lambda (new-param)
 840                                       (mapc (lambda (exclusive-group)
 841                                               (when (member new-param exclusive-group)
 842                                                 (mapcar (lambda (excluded-param)
 843                                                           (setq output (delete excluded-param output)))
 844                                                         exclusive-group)))
 845                                             exclusive-groups)
 846                                       (setq output (org-uniquify (cons new-param output))))
 847                                     new-params))
 848                             result-params)
 849                       output)))
 850       (mapc (lambda (plist)
 851               (mapc (lambda (pair)
 852                       (case (car pair)
 853                         (:var
 854                          ;; we want only one specification per variable
 855                          (when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair))
 856                            ;; TODO: When is this not true?
 857                            (setq var (intern (match-string 1 (cdr pair)))
 858                                  ref (match-string 2 (cdr pair))
 859                                  vars (cons (cons var ref) (assq-delete-all var vars)))))
 860                         (:results
 861                          (setq results
 862                                (e-merge results-exclusive-groups results (split-string (cdr pair)))))
 863                         (:file
 864                          (when (cdr pair)
 865                            (setq results (e-merge results-exclusive-groups results '("file")))
 866                            (unless (or (member "both" exports) (member "none" exports))
 867                              (setq exports (e-merge exports-exclusive-groups exports '("results"))))
 868                            (setq params (cons pair (assq-delete-all (car pair) params)))))
 869                         (:exports
 870                          (setq exports (e-merge exports-exclusive-groups
 871                                                 exports (split-string (cdr pair)))))
 872                         (:tangle
 873                          (setq tangle (e-merge '(("yes" "no"))
 874                                                tangle (split-string (or (cdr pair) "")))))
 875                         (:noweb
 876                          (setq noweb (e-merge '(("yes" "no"))
 877                                                noweb (split-string (or (cdr pair) "")))))
 878                         (:cache (setq cache t)) (:nocache (setq cache nil))
 879                         (t ;; replace: this covers e.g. :session
 880                          (setq params (cons pair (assq-delete-all (car pair) params))))))
 881                     plist))
 882             plists))
 883     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
 884     (while vars (setq params (cons (cons :var (pop vars)) params)))
 885     (cons (if cache (list :cache) (list :nocache))
 886           (cons (cons :noweb (mapconcat 'identity noweb " "))
 887                 (cons (cons :tangle (mapconcat 'identity tangle " "))
 888                       (cons (cons :exports (mapconcat 'identity exports " "))
 889                             (cons (cons :results (mapconcat 'identity results " "))
 890                                   params)))))))
 891
 892 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
 893   "This function expands Noweb style references in the body of
 894 the current source-code block.  For example the following
 895 reference would be replaced with the body of the source-code
 896 block named 'example-block'.
 897
 898 <<example-block>>
 899
 900 Note that any text preceding the <<foo>> construct on a line will
 901 be interposed between the lines of the replacement text.  So for
 902 example if <<foo>> is placed behind a comment, then the entire
 903 replacement text will also be commented.
 904
 905 This function must be called from inside of the buffer containing
 906 the source-code block which holds BODY.
 907
 908 In addition the following syntax can be used to insert the
 909 results of evaluating the source-code block named 'example-block'.
 910
 911 <<example-block()>>
 912
 913 Any optional arguments can be passed to example-block by placing
 914 the arguments inside the parenthesis following the convention
 915 defined by `org-babel-lob'.  For example
 916
 917 <<example-block(a=9)>>
 918
 919 would set the value of argument \"a\" equal to \"9\".  Note that
 920 these arguments are not evaluated in the current source-code
 921 block but are passed literally to the \"example-block\"."
 922   (let* ((parent-buffer (or parent-buffer (current-buffer)))
 923          (info (or info (org-babel-get-src-block-info)))
 924          (lang (first info))
 925          (body (second info))
 926          (new-body "") index source-name evaluate prefix)
 927     (flet ((nb-add (text)
 928                    (setq new-body (concat new-body text))))
 929       (with-temp-buffer
 930         (insert body) (goto-char (point-min))
 931         (funcall (intern (concat (or (and (cdr (assoc lang org-src-lang-modes))
 932                                           (symbol-name
 933                                            (cdr (assoc lang org-src-lang-modes))))
 934                                      lang) "-mode")))
 935         (setq index (point))
 936         (while (and (re-search-forward "<<\\(.+?\\)>>" nil t))
 937           (save-match-data (setf source-name (match-string 1)))
 938           (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
 939           (save-match-data
 940             (setq prefix (buffer-substring (match-beginning 0)
 941                                            (save-excursion
 942                                              (move-beginning-of-line 1) (point)))))
 943           ;; add interval to new-body (removing noweb reference)
 944           (goto-char (match-beginning 0))
 945           (nb-add (buffer-substring index (point)))
 946           (goto-char (match-end 0))
 947           (setq index (point))
 948           (nb-add (save-excursion
 949                     (set-buffer parent-buffer)
 950                     (mapconcat ;; interpose `prefix' between every line
 951                      #'identity
 952                      (split-string
 953                       (if evaluate
 954                           (let ((raw (org-babel-ref-resolve-reference
 955                                       source-name nil)))
 956                             (if (stringp raw) raw (format "%S" raw)))
 957                         (let ((point (org-babel-find-named-block source-name)))
 958                           (if point
 959                               (save-excursion
 960                                 (goto-char point)
 961                                 (org-babel-trim (org-babel-expand-noweb-references
 962                                                  (org-babel-get-src-block-info))))
 963                             ;; optionally raise an error if named
 964                             ;; source-block doesn't exist
 965                             (if (member lang org-babel-noweb-error-langs)
 966                                 (error
 967                                  "<<%s>> could not be resolved (see `org-babel-noweb-error-langs')"
 968                                  source-name)
 969                               "")))) "[\n\r]") (concat "\n" prefix)))))
 970         (nb-add (buffer-substring index (point-max)))))
 971     new-body))
 972
 973 (defun org-babel-clean-text-properties (text)
 974   "Strip all properties from text return."
 975   (set-text-properties 0 (length text) nil text) text)
 976
 977 (defun org-babel-strip-protective-commas (body)
 978   "Strip protective commas from bodies of source blocks."
 979   (replace-regexp-in-string "^,#" "#" body))
 980
 981 (defun org-babel-read (cell)
 982   "Convert the string value of CELL to a number if appropriate.
 983 Otherwise if cell looks like lisp (meaning it starts with a
 984 \"(\" or a \"'\") then read it as lisp, otherwise return it
 985 unmodified as a string.
 986
 987 This is taken almost directly from `org-read-prop'."
 988   (if (and (stringp cell) (not (equal cell "")))
 989       (or (org-babel-number-p cell)
 990           (if (or (equal "(" (substring cell 0 1))
 991                   (equal "'" (substring cell 0 1)))
 992               (read cell)
 993             (progn (set-text-properties 0 (length cell) nil cell) cell)))
 994     cell))
 995
 996 (defun org-babel-number-p (string)
 997   "Return t if STRING represents a number"
 998   (if (and (string-match "^-?[[:digit:]]*\\.?[[:digit:]]*$" string)
 999            (= (match-end 0) (length string)))
1000       (string-to-number string)))
1001
1002 (defun org-babel-import-elisp-from-file (file-name)
1003   "Read the results located at FILE-NAME into an elisp table.  If
1004 the table is trivial, then return it as a scalar."
1005   (let (result)
1006     (with-temp-buffer
1007       (condition-case nil
1008           (progn
1009             (org-table-import file-name nil)
1010             (delete-file file-name)
1011             (setq result (mapcar (lambda (row)
1012                                    (mapcar #'org-babel-string-read row))
1013                                  (org-table-to-lisp))))
1014         (error nil)))
1015     (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
1016         (if (consp (car result))
1017             (if (null (cdr (car result)))
1018                 (caar result)
1019               result)
1020           (car result))
1021       result)))
1022
1023 (defun org-babel-string-read (cell)
1024   "Strip nested \"s from around strings in exported R values."
1025   (org-babel-read (or (and (stringp cell)
1026                            (string-match "\\\"\\(.+\\)\\\"" cell)
1027                            (match-string 1 cell))
1028                       cell)))
1029
1030 (defun org-babel-reverse-string (string)
1031   (apply 'string (reverse (string-to-list string))))
1032
1033 (defun org-babel-chomp (string &optional regexp)
1034   "Remove any trailing space or carriage returns characters from
1035 STRING.  Default regexp used is \"[ \f\t\n\r\v]\" but can be
1036 overwritten by specifying a regexp as a second argument."
1037   (let ((regexp (or regexp "[ \f\t\n\r\v]")))
1038     (while (and (> (length string) 0) (string-match regexp (substring string -1)))
1039       (setq string (substring string 0 -1)))
1040     string))
1041
1042 (defun org-babel-trim (string &optional regexp)
1043   "Like `org-babel-chomp' only it runs on both the front and back of the string"
1044   (org-babel-chomp (org-babel-reverse-string
1045                     (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
1046
1047 (provide 'org-babel)
1048 ;;; org-babel.el ends here