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-pop-to-session-maybe ()
  65   "Detect if this is context for a org-babel src-block and if so
  66 then run `org-babel-pop-to-session'."
  67   (interactive)
  68   (let ((info (org-babel-get-src-block-info)))
  69     (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
  70
  71 (add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
  72
  73 (defvar org-babel-default-header-args
  74   '((:session . "none") (:results . "replace") (:exports . "code"))
  75   "Default arguments to use when evaluating a source block.")
  76
  77 (defvar org-babel-default-inline-header-args '((:results . "silent") (:exports . "code"))
  78   "Default arguments to use when evaluating an inline source block.")
  79
  80 (defvar org-babel-src-block-regexp nil
  81   "Regexp used to test when inside of a org-babel src-block")
  82
  83 (defvar org-babel-inline-src-block-regexp nil
  84   "Regexp used to test when on an inline org-babel src-block")
  85
  86 (defvar org-babel-min-lines-for-block-output 10
  87   "If number of lines of output is equal to or exceeds this
  88   value, the output is placed in a
  89   #+begin_example...#+end_example block. Otherwise the output is
  90   marked as literal by inserting colons at the starts of the
  91   lines. This variable only takes effect if the :results output
  92   option is in effect.")
  93
  94 (defun org-babel-named-src-block-regexp-for-name (name)
  95   "Regexp used to match named src block."
  96   (concat "#\\+srcname:[ \t]*" (regexp-quote name) "[ \t\n]*"
  97           (substring org-babel-src-block-regexp 1)))
  98
  99 (defun org-babel-set-interpreters (var value)
 100   (set-default var value)
 101   (setq org-babel-src-block-regexp
 102         (concat "^[ \t]*#\\+begin_src \\("
 103                 (mapconcat 'regexp-quote value "\\|")
 104                 "\\)[ \t]*"
 105                 "\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments
 106                 "\\([^\000]+?\\)#\\+end_src"))
 107   (setq org-babel-inline-src-block-regexp
 108         (concat "src_\\("
 109                 (mapconcat 'regexp-quote value "\\|")
 110                 "\\)"
 111                 "\\(\\|\\[\\(.*\\)\\]\\)"
 112                 "{\\([^\n]+\\)}")))
 113
 114 (defun org-babel-add-interpreter (interpreter)
 115   "Add INTERPRETER to `org-babel-interpreters' and update
 116 `org-babel-src-block-regexp' appropriately."
 117   (unless (member interpreter org-babel-interpreters)
 118     (setq org-babel-interpreters (cons interpreter org-babel-interpreters))
 119     (org-babel-set-interpreters 'org-babel-interpreters org-babel-interpreters)))
 120
 121 (defcustom org-babel-interpreters '()
 122   "Interpreters allows for evaluation tags.
 123 This is a list of program names (as strings) that can evaluate code and
 124 insert the output into an Org-mode buffer.  Valid choices are
 125
 126 R          Evaluate R code
 127 emacs-lisp Evaluate Emacs Lisp code and display the result
 128 sh         Pass command to the shell and display the result
 129 perl       The perl interpreter
 130 python     The python interpreter
 131 ruby       The ruby interpreter
 132
 133 The source block regexp `org-babel-src-block-regexp' is updated
 134 when a new interpreter is added to this list through the
 135 customize interface.  To add interpreters to this variable from
 136 lisp code use the `org-babel-add-interpreter' function."
 137   :group 'org-babel
 138   :set 'org-babel-set-interpreters
 139   :type '(set :greedy t
 140               (const "R")
 141               (const "emacs-lisp")
 142               (const "sh")
 143               (const "perl")
 144               (const "python")
 145               (const "ruby")))
 146
 147 ;;; functions
 148 (defun org-babel-execute-src-block (&optional arg info params)
 149   "Execute the current source code block, and dump the results
 150 into the buffer immediately following the block.  Results are
 151 commented by `org-toggle-fixed-width-section'.  With optional
 152 prefix don't dump results into buffer but rather return the
 153 results in raw elisp (this is useful for automated execution of a
 154 source block).
 155
 156 Optionally supply a value for INFO in the form returned by
 157 `org-babel-get-src-block-info'.
 158
 159 Optionally supply a value for PARAMS which will be merged with
 160 the header arguments specified at the source code block."
 161   (interactive)
 162   ;; (message "supplied params=%S" params) ;; debugging
 163   (let* ((info (or info (org-babel-get-src-block-info)))
 164          (lang (first info))
 165          (body (second info))
 166          (params (org-babel-merge-params
 167                   (third info) (org-babel-get-src-block-function-args) params))
 168          (processed-params (org-babel-process-params params))
 169          (result-params (third processed-params))
 170          (result-type (fourth processed-params))
 171          (cmd (intern (concat "org-babel-execute:" lang)))
 172          result)
 173     ;; (message "params=%S" params) ;; debugging statement
 174     (unless (member lang org-babel-interpreters)
 175       (error "Language is not in `org-babel-interpreters': %s" lang))
 176     (when arg (setq result-params (cons "silent" result-params)))
 177     (setq result (multiple-value-bind (session vars result-params result-type) processed-params
 178                    (funcall cmd body params)))
 179     (if (eq result-type 'value)
 180         (setq result (org-babel-process-value-result result result-params)))
 181     (org-babel-insert-result result result-params)
 182     (case result-type (output nil) (value result))))
 183
 184 (defun org-babel-pop-to-session (&optional arg info)
 185   "Pop to the session of the current source-code block.  If
 186 called with a prefix argument then evaluate the header arguments
 187 for the source block before entering the session.  Copy the body
 188 of the source block to the kill ring."
 189   (interactive)
 190   (let* ((info (or info (org-babel-get-src-block-info)))
 191          (lang (first info))
 192          (body (second info))
 193          (params (third info))
 194          (session (cdr (assoc :session params))))
 195     (unless (member lang org-babel-interpreters)
 196       (error "Language is not in `org-babel-interpreters': %s" lang))
 197     ;; copy body to the kill ring
 198     (with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max)))
 199     ;; if called with a prefix argument, then process header arguments
 200     (if arg (funcall (intern (concat "org-babel-prep-session:" lang)) session params))
 201     ;; just to the session using pop-to-buffer
 202     (pop-to-buffer (funcall (intern (format "org-babel-%s-initiate-session" lang)) session))
 203     (move-end-of-line 1)))
 204
 205 (defun org-babel-open-src-block-result (&optional re-run)
 206   "If `point' is on a src block then open the results of the
 207 source code block, otherwise return nil.  With optional prefix
 208 argument RE-RUN the source-code block is evaluated even if
 209 results already exist."
 210   (interactive "P")
 211   (when (org-babel-get-src-block-info)
 212     (save-excursion
 213       ;; go to the results, if there aren't any then run the block
 214       (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
 215                      (progn (org-babel-execute-src-block)
 216                             (org-babel-where-is-src-block-result))))
 217       (move-end-of-line 1) (forward-char 1)
 218       ;; open the results
 219       (if (looking-at org-bracket-link-regexp)
 220           ;; file results
 221           (org-open-at-point)
 222         (let ((results (org-babel-read-result)))
 223           (flet ((echo-res (result)
 224                            (if (stringp result) result (format "%S" result))))
 225             (pop-to-buffer (get-buffer-create "org-babel-results"))
 226             (delete-region (point-min) (point-max))
 227             (if (listp results)
 228                 ;; table result
 229                 (insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res)))
 230               ;; scalar result
 231               (insert (echo-res results))))))
 232       t)))
 233
 234 (defun org-babel-process-value-result (result result-params)
 235   "Process returned value for insertion in buffer.
 236
 237 Currently, this function forces to table output if :results
 238 vector has been supplied.
 239
 240   You can see below the various fragments of results-processing
 241 code that were present in the language-specific files. Out of
 242 those fragments, I've moved the org-babel-python-table-or-results
 243 and org-babel-import-elisp-from-file functionality into the
 244 org-babel-*-evaluate functions. I think those should only be used
 245 in the :results value case, as in the 'output case we are not
 246 concerned with creating elisp versions of results. "
 247
 248   (if (and (member "vector" result-params) (not (listp result)))
 249       (list (list result))
 250     result))
 251
 252 (defun org-babel-execute-buffer (&optional arg)
 253   "Replace EVAL snippets in the entire buffer."
 254   (interactive "P")
 255   (save-excursion
 256     (goto-char (point-min))
 257     (while (re-search-forward org-babel-src-block-regexp nil t)
 258       (goto-char (match-beginning 0))
 259       (org-babel-execute-src-block arg)
 260       (goto-char (match-end 0)))))
 261
 262 (defun org-babel-execute-subtree (&optional arg)
 263   "Replace EVAL snippets in the entire subtree."
 264   (interactive "P")
 265   (save-excursion
 266     (org-narrow-to-subtree)
 267     (org-babel-execute-buffer)
 268     (widen)))
 269
 270 (defun org-babel-get-src-block-name ()
 271   "Return the name of the current source block if one exists.
 272
 273 This function is analogous to org-babel-lob-get-info. For both
 274 functions, after they are called, (match-string 1) matches the
 275 function name, and (match-string 3) matches the function
 276 arguments inside the parentheses. I think perhaps these functions
 277 should be renamed to bring out this similarity, perhaps involving
 278 the word 'call'.
 279
 280 Currently the function `org-babel-get-src-block-function-args'
 281 relies on the match-data from a match in this function.  I think
 282 splitting a match and the use of it's data is bad form, and we
 283 should re-work these two functions, perhaps combining them into
 284 one function which returns more data than just the name. [Eric]"
 285   (let ((case-fold-search t)
 286         (head (org-babel-where-is-src-block-head)))
 287     (if head
 288         (save-excursion
 289           (goto-char head)
 290           (if (save-excursion
 291                 (forward-line -1)
 292                 ;; the second match of this regexp is used later to
 293                 ;; find arguments in the "functional" style, where
 294                 ;; they are passed as part of the source name line
 295                 (looking-at "#\\+srcname:[ \f\t\n\r\v]*\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
 296               (org-babel-clean-text-properties (match-string 1)))))))
 297
 298 (defun org-babel-get-src-block-info ()
 299   "Return the information of the current source block as a list
 300 of the following form.  (language body header-arguments-alist)"
 301   (let ((case-fold-search t) head)
 302     (if (setq head (org-babel-where-is-src-block-head))
 303         (save-excursion (goto-char head) (org-babel-parse-src-block-match))
 304       (if (save-excursion ;; inline source block
 305             (re-search-backward "[ \f\t\n\r\v]" nil t)
 306             (forward-char 1)
 307             (looking-at org-babel-inline-src-block-regexp))
 308           (org-babel-parse-inline-src-block-match)
 309         nil)))) ;; indicate that no source block was found
 310
 311 (defun org-babel-get-src-block-function-args ()
 312   (when (org-babel-get-src-block-name)
 313     (mapcar (lambda (ref) (cons :var ref))
 314             (org-babel-ref-split-args (match-string 3)))))
 315
 316 (defmacro org-babel-map-source-blocks (file &rest body)
 317   "Evaluate BODY forms on each source-block in FILE."
 318   (declare (indent 1))
 319   `(let ((visited-p (get-buffer (file-name-nondirectory ,file))))
 320      (save-window-excursion
 321        (find-file ,file) (goto-char (point-min))
 322        (while (re-search-forward org-babel-src-block-regexp nil t)
 323          (goto-char (match-beginning 0))
 324          (save-match-data ,@body)
 325          (goto-char (match-end 0))))
 326      (unless visited-p (kill-buffer (file-name-nondirectory file)))))
 327
 328 (defun org-babel-params-from-properties ()
 329   "Return an association list of any source block params which
 330 may be specified in the properties of the current outline entry."
 331   (save-match-data
 332     (delq nil
 333           (mapcar
 334            (lambda (header-arg)
 335              (let ((val (org-entry-get (point) header-arg)))
 336                (when val
 337                  ;; (message "param-from-property %s=%s" header-arg val) ;; debugging statement
 338                  (cons (intern (concat ":" header-arg)) val))))
 339            '("results" "exports" "tangle" "var")))))
 340
 341 (defun org-babel-parse-src-block-match ()
 342   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 343          (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
 344          (body (org-babel-clean-text-properties (match-string 4))))
 345     (list lang
 346           ;; get src block body removing properties, protective commas, and indentation
 347           (with-temp-buffer
 348             (save-match-data
 349               (insert (org-babel-strip-protective-commas body))
 350               (org-do-remove-indentation)
 351               (buffer-string)))
 352           (org-babel-merge-params
 353            org-babel-default-header-args
 354            (org-babel-params-from-properties)
 355            (if (boundp lang-headers) (eval lang-headers) nil)
 356            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 357
 358 (defun org-babel-parse-inline-src-block-match ()
 359   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 360          (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
 361     (list lang
 362           (org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 4)))
 363           (org-babel-merge-params
 364            org-babel-default-inline-header-args
 365            (org-babel-params-from-properties)
 366            (if (boundp lang-headers) (eval lang-headers) nil)
 367            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 368
 369 (defun org-babel-parse-header-arguments (arg-string)
 370   "Parse a string of header arguments returning an alist."
 371   (if (> (length arg-string) 0)
 372       (delq nil
 373             (mapcar
 374              (lambda (arg)
 375                (if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg)
 376                    (cons (intern (concat ":" (match-string 1 arg)))
 377                          (org-babel-chomp (match-string 2 arg)))
 378                  (cons (intern (concat ":" arg)) nil)))
 379              (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
 380
 381 (defun org-babel-process-params (params)
 382   "Parse params and resolve references.
 383
 384 Return a list (session vars result-params result-type). These are
 385 made available to the org-babel-execute:LANG functions via
 386 multiple-value-bind."
 387   (let* ((session (cdr (assoc :session params)))
 388          (vars (org-babel-ref-variables params))
 389          (result-params (split-string (or (cdr (assoc :results params)) "")))
 390          (result-type (cond ((member "output" result-params) 'output)
 391                             ((member "value" result-params) 'value)
 392                             (t 'value))))
 393     (list session vars result-params result-type)))
 394
 395 (defun org-babel-where-is-src-block-head ()
 396   "Return the point at the beginning of the current source
 397 block.  Specifically at the beginning of the #+BEGIN_SRC line.
 398 If the point is not on a source block then return nil."
 399   (let ((initial (point)) top bottom)
 400     (or
 401      (save-excursion ;; on a #+srcname: line
 402        (beginning-of-line 1)
 403        (and (looking-at "#\\+srcname") (forward-line 1)
 404             (looking-at org-babel-src-block-regexp)
 405             (point)))
 406      (save-excursion ;; on a #+begin_src line
 407        (beginning-of-line 1)
 408        (and (looking-at org-babel-src-block-regexp)
 409             (point)))
 410      (save-excursion ;; inside a src block
 411        (and
 412         (re-search-backward "#\\+begin_src" nil t) (setq top (point))
 413         (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
 414         (< top initial) (< initial bottom)
 415         (goto-char top) (looking-at org-babel-src-block-regexp)
 416         (point))))))
 417
 418 (defun org-babel-goto-named-source-block (&optional name)
 419   "Go to a named source-code block."
 420   (interactive "ssource-block name: ")
 421   (let ((point (org-babel-find-named-block name)))
 422     (if point
 423         ;; taken from `org-open-at-point'
 424         (progn (goto-char point) (org-show-context))
 425       (message "source-code block '%s' not found in this buffer" name))))
 426
 427 (defun org-babel-find-named-block (name)
 428   "Find a named source-code block.
 429 Return the location of the source block identified by
 430 #+srcname NAME, or nil if no such block exists. Set match data
 431 according to org-babel-named-src-block-regexp."
 432   (save-excursion
 433     (let ((case-fold-search t)
 434           (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
 435       (goto-char (point-min))
 436       (when (or (re-search-forward regexp nil t)
 437                 (re-search-backward regexp nil t))
 438         (match-beginning 0)))))
 439
 440 (defun org-babel-find-named-result (name)
 441   "Return the location of the result named NAME in the current
 442 buffer or nil if no such result exists."
 443   (save-excursion
 444     (goto-char (point-min))
 445     (when (re-search-forward ;; ellow end-of-buffer in following regexp?
 446            (concat "#\\+resname:[ \t]*" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
 447       (move-beginning-of-line 0) (point))))
 448
 449 (defun org-babel-where-is-src-block-result (&optional insert)
 450   "Return the point at the beginning of the result of the current
 451 source block.  Specifically at the beginning of the #+RESNAME:
 452 line.  If no result exists for this block then create a
 453 #+RESNAME: line following the source block."
 454   (save-excursion
 455     (let* ((on-lob-line (progn (beginning-of-line 1)
 456                                (looking-at org-babel-lob-one-liner-regexp)))
 457            (name (if on-lob-line (org-babel-lob-get-info) (org-babel-get-src-block-name)))
 458            (head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
 459       (when head (goto-char head))
 460       (or (and name (org-babel-find-named-result name))
 461           (and (or on-lob-line (re-search-forward "#\\+end_src" nil t))
 462                (progn (move-end-of-line 1)
 463                       (if (eobp) (insert "\n") (forward-char 1))
 464                       (setq end (point))
 465                       (or (progn ;; either an unnamed #+resname: line already exists
 466                             (re-search-forward "[^ \f\t\n\r\v]" nil t)
 467                             (move-beginning-of-line 1) (looking-at "#\\+resname:"))
 468                           ;; or (with optional insert) we need to back up and make one ourselves
 469                           (when insert
 470                             (goto-char end) (open-line 2) (forward-char 1)
 471                             (insert (concat "#+resname:" (if name (concat " " name))))
 472                             (move-beginning-of-line 1) t)))
 473                (point))))))
 474
 475 (defun org-babel-read-result ()
 476   "Read the result at `point' into emacs-lisp."
 477   (cond
 478    ((org-at-table-p) (org-babel-read-table))
 479    ((looking-at ": ")
 480     (let ((result-string
 481            (org-babel-trim
 482             (mapconcat (lambda (line) (if (and (> (length line) 1)
 483                                                (string= ": " (substring line 0 2)))
 484                                           (substring line 2)
 485                                         line))
 486                        (split-string
 487                         (buffer-substring (point) (org-babel-result-end)) "[\r\n]+")
 488                        "\n"))))
 489       (or (org-babel-number-p result-string) result-string)))
 490    ((looking-at "^#\\+RESNAME:")
 491     (save-excursion (forward-line 1) (org-babel-read-result)))))
 492
 493 (defun org-babel-read-table ()
 494   "Read the table at `point' into emacs-lisp."
 495   (mapcar (lambda (row)
 496             (if (and (symbolp row) (equal row 'hline)) row
 497               (mapcar #'org-babel-read row)))
 498           (org-table-to-lisp)))
 499
 500 (defun org-babel-insert-result (result &optional insert)
 501   "Insert RESULT into the current buffer after the end of the
 502 current source block.  With optional argument INSERT controls
 503 insertion of results in the org-mode file.  INSERT can take the
 504 following values...
 505
 506 replace - (default option) insert results after the source block
 507           replacing any previously inserted results
 508
 509 silent -- no results are inserted
 510
 511 file ---- the results are interpreted as a file path, and are
 512           inserted into the buffer using the Org-mode file syntax
 513
 514 raw ----- results are added directly to the org-mode file.  This
 515           is a good option if you code block will output org-mode
 516           formatted text.
 517
 518 org ----- this is the same as the 'raw' option
 519
 520 html ---- results are added inside of a #+BEGIN_HTML block.  This
 521           is a good option if you code block will output html
 522           formatted text.
 523
 524 latex --- results are added inside of a #+BEGIN_LATEX block.
 525           This is a good option if you code block will output
 526           latex formatted text."
 527   (if (stringp result)
 528       (progn
 529         (setq result (org-babel-clean-text-properties result))
 530         (if (member "file" insert) (setq result (org-babel-result-to-file result))))
 531     (unless (listp result) (setq result (format "%S" result))))
 532   (if (and insert (member "replace" insert) (not (member "silent" insert)))
 533       (org-babel-remove-result))
 534   (if (= (length result) 0)
 535       (if (member "value" result-params)
 536           (message "No result returned by source block")
 537         (message "Source block produced no output"))
 538     (if (and insert (member "silent" insert))
 539         (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
 540       (when (and (stringp result) ;; ensure results end in a newline
 541                  (not (or (string-equal (substring result -1) "\n")
 542                           (string-equal (substring result -1) "\r"))))
 543         (setq result (concat result "\n")))
 544       (save-excursion
 545         (let ((existing-result (org-babel-where-is-src-block-result t)))
 546           (when existing-result (goto-char existing-result) (forward-line 1)))
 547         (if (stringp result) ;; assume the result is a table if it's not a string
 548             (if (member "file" insert)
 549                 (insert result)
 550               (if (member "html" insert)
 551                   (insert (format "#+BEGIN_HTML\n%s#+END_HTML\n" result))
 552                 (if (member "latex" insert)
 553                     (insert (format "#+BEGIN_LaTeX\n%s#+END_LaTeX\n" result))
 554                   (if (or (member "raw" insert) (member "org" insert))
 555                       (progn (save-excursion (insert result))
 556                              (if (org-at-table-p) (org-cycle)))
 557                     (org-babel-examplize-region (point) (progn (insert result) (point)))))))
 558           (progn
 559             (insert
 560              (concat (orgtbl-to-orgtbl
 561                       (if (and (listp (car result)) (listp (cdr (car result))))
 562                           result (list result))
 563                       '(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
 564             (forward-line -1)
 565             (org-cycle))))
 566       (message "finished"))))
 567
 568 (defun org-babel-result-to-org-string (result)
 569   "Return RESULT as a string in org-mode format.  This function
 570 relies on `org-babel-insert-result'."
 571   (with-temp-buffer (org-babel-insert-result result) (buffer-string)))
 572
 573 (defun org-babel-remove-result ()
 574   "Remove the result of the current source block."
 575   (interactive)
 576   (save-excursion
 577     (goto-char (org-babel-where-is-src-block-result t)) (forward-line 1)
 578     (delete-region (save-excursion (move-beginning-of-line 0) (point)) (org-babel-result-end))))
 579
 580 (defun org-babel-result-end ()
 581   "Return the point at the end of the current set of results"
 582   (save-excursion
 583     (if (org-at-table-p)
 584         (progn (goto-char (org-table-end)) (forward-line 1) (point))
 585       (let ((case-fold-search t))
 586         (cond
 587          ((looking-at "#\\+begin_latex")
 588           (search-forward "#+end_latex" nil t)
 589           (forward-line 2))
 590          ((looking-at "#\\+begin_html")
 591           (search-forward "#+end_html" nil t)
 592           (forward-line 2))
 593          ((looking-at "#\\+begin_example")
 594           (search-forward "#+end_example" nil t)
 595           (forward-line 2))
 596          (t (progn (while (looking-at "\\(: \\|\\[\\[\\)")
 597                      (forward-line 1))
 598                    (forward-line 1)))))
 599       (point))))
 600
 601 (defun org-babel-result-to-file (result)
 602   "Return an `org-mode' link with the path being the value or
 603 RESULT, and the display being the `file-name-nondirectory' if
 604 non-nil."
 605   (concat "[[file:" result "]]"))
 606
 607 (defun org-babel-examplize-region (beg end)
 608   "Comment out region using the ': ' org example quote."
 609   (interactive "*r")
 610   (let ((size (abs (- (line-number-at-pos end)
 611                       (line-number-at-pos beg)))))
 612     (save-excursion
 613       (cond ((= size 0)
 614              (error "This should be impossible: a newline was appended to result if missing")
 615              (let ((result (buffer-substring beg end)))
 616                (delete-region beg end)
 617                (insert (concat ": " result))))
 618             ((< size org-babel-min-lines-for-block-output)
 619              (goto-char beg)
 620              (dotimes (n size)
 621                (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
 622             (t
 623              (goto-char beg)
 624              (insert "#+begin_example\n")
 625              (forward-char (- end beg))
 626              (insert "#+end_example\n"))))))
 627
 628 (defun org-babel-merge-params (&rest plists)
 629   "Combine all parameter association lists in PLISTS.  Later
 630 elements of PLISTS override the values of previous element.  This
 631 takes into account some special considerations for certain
 632 parameters when merging lists."
 633   (let (params results exports tangle vars var ref)
 634     (flet ((e-merge (exclusive-groups &rest result-params)
 635                     ;; maintain exclusivity of mutually exclusive parameters
 636                     (let (output)
 637                       (mapc (lambda (new-params)
 638                               (mapc (lambda (new-param)
 639                                       (mapc (lambda (exclusive-group)
 640                                               (when (member new-param exclusive-group)
 641                                                 (mapcar (lambda (excluded-param)
 642                                                           (setq output (delete excluded-param output)))
 643                                                         exclusive-group)))
 644                                             exclusive-groups)
 645                                       (setq output (org-uniquify (cons new-param output))))
 646                                     new-params))
 647                             result-params)
 648                       output)))
 649       (mapc (lambda (plist)
 650               (mapc (lambda (pair)
 651                       (case (car pair)
 652                         (:var
 653                          ;; we want only one specification per variable
 654                          (when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair))
 655                            ;; TODO: When is this not true?
 656                            (setq var (intern (match-string 1 (cdr pair)))
 657                                  ref (match-string 2 (cdr pair))
 658                                  vars (cons (cons var ref) (assq-delete-all var vars)))))
 659                         (:results
 660                          (setq results (e-merge
 661                                         '(("file" "vector" "scalar" "raw" "org" "html" "latex")
 662                                           ("replace" "silent")
 663                                           ("output" "value"))
 664                                         results (split-string (cdr pair)))))
 665                         (:exports
 666                          (setq exports (e-merge '(("code" "results" "both" "none"))
 667                                                 exports (split-string (cdr pair)))))
 668                         (:tangle
 669                          (setq tangle (e-merge '(("yes" "no"))
 670                                                tangle (split-string (cdr pair)))))
 671                         (t ;; replace: this covers e.g. :session
 672                          (setq params (cons pair (assq-delete-all (car pair) params))))))
 673                     plist))
 674             plists))
 675     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
 676     (while vars (setq params (cons (cons :var (pop vars)) params)))
 677     (cons (cons :tangle (mapconcat 'identity tangle " "))
 678           (cons (cons :exports (mapconcat 'identity exports " "))
 679                 (cons (cons :results (mapconcat 'identity results " "))
 680                       params)))))
 681
 682 (defun org-babel-clean-text-properties (text)
 683   "Strip all properties from text return."
 684   (set-text-properties 0 (length text) nil text) text)
 685
 686 (defun org-babel-strip-protective-commas (body)
 687   "Strip protective commas from bodies of source blocks."
 688   (replace-regexp-in-string "^,#" "#" body))
 689
 690 (defun org-babel-read (cell)
 691   "Convert the string value of CELL to a number if appropriate.
 692 Otherwise if cell looks like lisp (meaning it starts with a
 693 \"(\" or a \"'\") then read it as lisp, otherwise return it
 694 unmodified as a string.
 695
 696 This is taken almost directly from `org-read-prop'."
 697   (if (and (stringp cell) (not (equal cell "")))
 698       (or (org-babel-number-p cell)
 699           (if (or (equal "(" (substring cell 0 1))
 700                   (equal "'" (substring cell 0 1)))
 701               (read cell)
 702             (progn (set-text-properties 0 (length cell) nil cell) cell)))
 703     cell))
 704
 705 (defun org-babel-number-p (string)
 706   "Return t if STRING represents a number"
 707   (if (and (string-match "^-?[[:digit:]]*\\.?[[:digit:]]*$" string)
 708            (= (match-end 0) (length string)))
 709       (string-to-number string)))
 710
 711 (defun org-babel-import-elisp-from-file (file-name)
 712   "Read the results located at FILE-NAME into an elisp table.  If
 713 the table is trivial, then return it as a scalar."
 714   (let (result)
 715     (with-temp-buffer
 716       (condition-case nil
 717           (progn
 718             (org-table-import file-name nil)
 719             (delete-file file-name)
 720             (setq result (mapcar (lambda (row)
 721                                    (mapcar #'org-babel-string-read row))
 722                                  (org-table-to-lisp))))
 723         (error nil)))
 724     (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
 725         (if (consp (car result))
 726             (if (null (cdr (car result)))
 727                 (caar result)
 728               result)
 729           (car result))
 730       result)))
 731
 732 (defun org-babel-string-read (cell)
 733   "Strip nested \"s from around strings in exported R values."
 734   (org-babel-read (or (and (stringp cell)
 735                            (string-match "\\\"\\(.+\\)\\\"" cell)
 736                            (match-string 1 cell))
 737                       cell)))
 738
 739 (defun org-babel-reverse-string (string)
 740   (apply 'string (reverse (string-to-list string))))
 741
 742 (defun org-babel-chomp (string &optional regexp)
 743   "Remove any trailing space or carriage returns characters from
 744 STRING.  Default regexp used is \"[ \f\t\n\r\v]\" but can be
 745 overwritten by specifying a regexp as a second argument."
 746   (while (and (> (length string) 0) (string-match "[ \f\t\n\r\v]" (substring string -1)))
 747     (setq string (substring string 0 -1)))
 748   string)
 749
 750 (defun org-babel-trim (string &optional regexp)
 751   "Like `org-babel-chomp' only it runs on both the front and back of the string"
 752   (org-babel-chomp (org-babel-reverse-string
 753                     (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
 754
 755 (provide 'org-babel)
 756 ;;; org-babel.el ends here