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