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 '((:session . "none") (:results . "replace"))
  74   "Default arguments to use when evaluating a source block.")
  75
  76 (defvar org-babel-default-inline-header-args '((:results . "silent") (:exports . "code"))
  77   "Default arguments to use when evaluating an inline source block.")
  78
  79 (defvar org-babel-src-block-regexp nil
  80   "Regexp used to test when inside of a org-babel src-block")
  81
  82 (defvar org-babel-inline-src-block-regexp nil
  83   "Regexp used to test when on an inline org-babel src-block")
  84
  85 (defvar org-babel-min-lines-for-block-output 10
  86   "If number of lines of output is equal to or exceeds this
  87   value, the output is placed in a
  88   #+begin_example...#+end_example block. Otherwise the output is
  89   marked as literal by inserting colons at the starts of the
  90   lines. This variable only takes effect if the :results output
  91   option is in effect.")
  92
  93 (defun org-babel-named-src-block-regexp-for-name (name)
  94   "Regexp used to match named src block."
  95   (concat "#\\+srcname:[ \t]*" (regexp-quote name) "[ \t\n]*"
  96           (substring org-babel-src-block-regexp 1)))
  97
  98 (defun org-babel-set-interpreters (var value)
  99   (set-default var value)
 100   (setq org-babel-src-block-regexp
 101         (concat "^[ \t]*#\\+begin_src \\("
 102                 (mapconcat 'regexp-quote value "\\|")
 103                 "\\)[ \t]*"
 104                 "\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments
 105                 "\\([^\000]+?\\)#\\+end_src"))
 106   (setq org-babel-inline-src-block-regexp
 107         (concat "src_\\("
 108                 (mapconcat 'regexp-quote value "\\|")
 109                 "\\)"
 110                 "\\(\\|\\[\\(.*\\)\\]\\)"
 111                 "{\\([^\n]+\\)}")))
 112
 113 (defun org-babel-add-interpreter (interpreter)
 114   "Add INTERPRETER to `org-babel-interpreters' and update
 115 `org-babel-src-block-regexp' appropriately."
 116   (unless (member interpreter org-babel-interpreters)
 117     (setq org-babel-interpreters (cons interpreter org-babel-interpreters))
 118     ;; (add-to-list 'org-babel-session-defaults (cons interpreter (format "org-babel-%s" interpreter)))
 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           (with-temp-buffer ;; get src block body removing properties, protective commas, and indentation
 347             (save-match-data
 348               (insert (org-babel-strip-protective-commas body))
 349               (org-do-remove-indentation)
 350               (buffer-string)))
 351           (org-babel-merge-params
 352            org-babel-default-header-args
 353            (org-babel-params-from-properties)
 354            (if (boundp lang-headers) (eval lang-headers) nil)
 355            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 356
 357 (defun org-babel-parse-inline-src-block-match ()
 358   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 359          (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
 360     (list lang
 361           (org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 4)))
 362           (org-babel-merge-params
 363            org-babel-default-inline-header-args
 364            (org-babel-params-from-properties)
 365            (if (boundp lang-headers) (eval lang-headers) nil)
 366            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 367
 368 (defun org-babel-parse-header-arguments (arg-string)
 369   "Parse a string of header arguments returning an alist."
 370   (if (> (length arg-string) 0)
 371       (delq nil
 372             (mapcar
 373              (lambda (arg)
 374                (if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg)
 375                    (cons (intern (concat ":" (match-string 1 arg)))
 376                          (org-babel-chomp (match-string 2 arg)))
 377                  (cons (intern (concat ":" arg)) nil)))
 378              (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
 379
 380 (defun org-babel-process-params (params)
 381   "Parse params and resolve references.
 382
 383 Return a list (session vars result-params result-type). These are
 384 made available to the org-babel-execute:LANG functions via
 385 multiple-value-bind."
 386   (let* ((session (cdr (assoc :session params)))
 387          (vars (org-babel-ref-variables params))
 388          (result-params (split-string (or (cdr (assoc :results params)) "")))
 389          (result-type (cond ((member "output" result-params) 'output)
 390                             ((member "value" result-params) 'value)
 391                             (t 'value))))
 392     (list session vars result-params result-type)))
 393
 394 (defun org-babel-where-is-src-block-head ()
 395   "Return the point at the beginning of the current source
 396 block.  Specifically at the beginning of the #+BEGIN_SRC line.
 397 If the point is not on a source block then return nil."
 398   (let ((initial (point)) top bottom)
 399     (or
 400      (save-excursion ;; on a #+srcname: line
 401        (beginning-of-line 1)
 402        (and (looking-at "#\\+srcname") (forward-line 1)
 403             (looking-at org-babel-src-block-regexp)
 404             (point)))
 405      (save-excursion ;; on a #+begin_src line
 406        (beginning-of-line 1)
 407        (and (looking-at org-babel-src-block-regexp)
 408             (point)))
 409      (save-excursion ;; inside a src block
 410        (and
 411         (re-search-backward "#\\+begin_src" nil t) (setq top (point))
 412         (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
 413         (< top initial) (< initial bottom)
 414         (goto-char top) (looking-at org-babel-src-block-regexp)
 415         (point))))))
 416
 417 (defun org-babel-goto-named-source-block (&optional name)
 418   "Go to a named source-code block."
 419   (interactive "ssource-block name: ")
 420   (let ((point (org-babel-find-named-block name)))
 421     (if point
 422         ;; taken from `org-open-at-point'
 423         (progn (goto-char point) (org-show-context))
 424       (message "source-code block '%s' not found in this buffer" name))))
 425
 426 (defun org-babel-find-named-block (name)
 427   "Find a named source-code block.
 428 Return the location of the source block identified by
 429 #+srcname NAME, or nil if no such block exists. Set match data
 430 according to org-babel-named-src-block-regexp."
 431   (save-excursion
 432     (let ((case-fold-search t)
 433           (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
 434       (goto-char (point-min))
 435       (when (or (re-search-forward regexp nil t)
 436                 (re-search-backward regexp nil t))
 437         (match-beginning 0)))))
 438
 439 (defun org-babel-find-named-result (name)
 440   "Return the location of the result named NAME in the current
 441 buffer or nil if no such result exists."
 442   (save-excursion
 443     (goto-char (point-min))
 444     (when (re-search-forward ;; ellow end-of-buffer in following regexp?
 445            (concat "#\\+resname:[ \t]*" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
 446       (move-beginning-of-line 0) (point))))
 447
 448 (defun org-babel-where-is-src-block-result (&optional insert)
 449   "Return the point at the beginning of the result of the current
 450 source block.  Specifically at the beginning of the #+RESNAME:
 451 line.  If no result exists for this block then create a
 452 #+RESNAME: line following the source block."
 453   (save-excursion
 454     (let* ((on-lob-line (progn (beginning-of-line 1)
 455                                (looking-at org-babel-lob-one-liner-regexp)))
 456            (name (if on-lob-line (org-babel-lob-get-info) (org-babel-get-src-block-name)))
 457            (head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
 458       (when head (goto-char head))
 459       (or (and name (org-babel-find-named-result name))
 460           (and (or on-lob-line (re-search-forward "#\\+end_src" nil t))
 461                (progn (move-end-of-line 1)
 462                       (if (eobp) (insert "\n") (forward-char 1))
 463                       (setq end (point))
 464                       (or (progn ;; either an unnamed #+resname: line already exists
 465                             (re-search-forward "[^ \f\t\n\r\v]" nil t)
 466                             (move-beginning-of-line 1) (looking-at "#\\+resname:"))
 467                           ;; or (with optional insert) we need to back up and make one ourselves
 468                           (when insert
 469                             (goto-char end) (open-line 2) (forward-char 1)
 470                             (insert (concat "#+resname:" (if name (concat " " name))))
 471                             (move-beginning-of-line 1) t)))
 472                (point))))))
 473
 474 (defun org-babel-read-result ()
 475   "Read the result at `point' into emacs-lisp."
 476   (cond
 477    ((org-at-table-p) (org-babel-read-table))
 478    ((looking-at ": ")
 479     (let ((result-string
 480            (org-babel-trim
 481             (mapconcat (lambda (line) (if (and (> (length line) 1)
 482                                                (string= ": " (substring line 0 2)))
 483                                           (substring line 2)
 484                                         line))
 485                        (split-string
 486                         (buffer-substring (point) (org-babel-result-end)) "[\r\n]+")
 487                        "\n"))))
 488       (or (org-babel-number-p result-string) result-string)))
 489    ((looking-at "^#\\+RESNAME:")
 490     (save-excursion (forward-line 1) (org-babel-read-result)))))
 491
 492 (defun org-babel-read-table ()
 493   "Read the table at `point' into emacs-lisp."
 494   (mapcar (lambda (row)
 495             (if (and (symbolp row) (equal row 'hline)) row
 496               (mapcar #'org-babel-read row)))
 497           (org-table-to-lisp)))
 498
 499 (defun org-babel-insert-result (result &optional insert)
 500   "Insert RESULT into the current buffer after the end of the
 501 current source block.  With optional argument INSERT controls
 502 insertion of results in the org-mode file.  INSERT can take the
 503 following values...
 504
 505 replace - (default option) insert results after the source block
 506           replacing any previously inserted results
 507
 508 silent -- no results are inserted
 509
 510 file ---- the results are interpreted as a file path, and are
 511           inserted into the buffer using the Org-mode file syntax
 512
 513 raw ----- results are added directly to the org-mode file.  This
 514           is a good option if you code block will output org-mode
 515           formatted text.
 516
 517 org ----- this is the same as the 'raw' option
 518
 519 html ---- results are added inside of a #+BEGIN_HTML block.  This
 520           is a good option if you code block will output html
 521           formatted text.
 522
 523 latex --- results are added inside of a #+BEGIN_LATEX block.
 524           This is a good option if you code block will output
 525           latex formatted text."
 526   (if (stringp result)
 527       (progn
 528         (setq result (org-babel-clean-text-properties result))
 529         (if (member "file" insert) (setq result (org-babel-result-to-file result))))
 530     (unless (listp result) (setq result (format "%S" result))))
 531   (if (and insert (member "replace" insert) (not (member "silent" insert)))
 532       (org-babel-remove-result))
 533   (if (= (length result) 0)
 534       (if (member "value" result-params)
 535           (message "No result returned by source block")
 536         (message "Source block produced no output"))
 537     (if (and insert (member "silent" insert))
 538         (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
 539       (when (and (stringp result) ;; ensure results end in a newline
 540                  (not (or (string-equal (substring result -1) "\n")
 541                           (string-equal (substring result -1) "\r"))))
 542         (setq result (concat result "\n")))
 543       (save-excursion
 544         (let ((existing-result (org-babel-where-is-src-block-result t)))
 545           (when existing-result (goto-char existing-result) (forward-line 1)))
 546         (if (stringp result) ;; assume the result is a table if it's not a string
 547             (if (member "file" insert)
 548                 (insert result)
 549               (if (member "html" insert)
 550                   (insert (format "#+BEGIN_HTML\n%s#+END_HTML\n" result))
 551                 (if (member "latex" insert)
 552                     (insert (format "#+BEGIN_LaTeX\n%s#+END_LaTeX\n" result))
 553                   (if (or (member "raw" insert) (member "org" insert))
 554                       (progn (save-excursion (insert result))
 555                              (if (org-at-table-p) (org-cycle)))
 556                     (org-babel-examplize-region (point) (progn (insert result) (point)))))))
 557           (progn
 558             (insert
 559              (concat (orgtbl-to-orgtbl
 560                       (if (and (listp (car result)) (listp (cdr (car result))))
 561                           result (list result))
 562                       '(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
 563             (forward-line -1)
 564             (org-cycle))))
 565       (message "finished"))))
 566
 567 (defun org-babel-result-to-org-string (result)
 568   "Return RESULT as a string in org-mode format.  This function
 569 relies on `org-babel-insert-result'."
 570   (with-temp-buffer (org-babel-insert-result result) (buffer-string)))
 571
 572 (defun org-babel-remove-result ()
 573   "Remove the result of the current source block."
 574   (interactive)
 575   (save-excursion
 576     (goto-char (org-babel-where-is-src-block-result t)) (forward-line 1)
 577     (delete-region (save-excursion (move-beginning-of-line 0) (point)) (org-babel-result-end))))
 578
 579 (defun org-babel-result-end ()
 580   "Return the point at the end of the current set of results"
 581   (save-excursion
 582     (if (org-at-table-p)
 583         (progn (goto-char (org-table-end)) (forward-line 1) (point))
 584       (let ((case-fold-search t))
 585         (cond
 586          ((looking-at "#\\+begin_latex")
 587           (search-forward "#+end_latex" nil t)
 588           (forward-line 2))
 589          ((looking-at "#\\+begin_html")
 590           (search-forward "#+end_html" nil t)
 591           (forward-line 2))
 592          ((looking-at "#\\+begin_example")
 593           (search-forward "#+end_example" nil t)
 594           (forward-line 2))
 595          (t (progn (while (looking-at "\\(: \\|\\[\\[\\)")
 596                      (forward-line 1))
 597                    (forward-line 1)))))
 598       (point))))
 599
 600 (defun org-babel-result-to-file (result)
 601   "Return an `org-mode' link with the path being the value or
 602 RESULT, and the display being the `file-name-nondirectory' if
 603 non-nil."
 604   (concat "[[file:" result "]]"))
 605
 606 (defun org-babel-examplize-region (beg end)
 607   "Comment out region using the ': ' org example quote."
 608   (interactive "*r")
 609   (let ((size (abs (- (line-number-at-pos end)
 610                       (line-number-at-pos beg)))))
 611     (save-excursion
 612       (cond ((= size 0)
 613              (error "This should be impossible: a newline was appended to result if missing")
 614              (let ((result (buffer-substring beg end)))
 615                (delete-region beg end)
 616                (insert (concat ": " result))))
 617             ((< size org-babel-min-lines-for-block-output)
 618              (goto-char beg)
 619              (dotimes (n size)
 620                (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
 621             (t
 622              (goto-char beg)
 623              (insert "#+begin_example\n")
 624              (forward-char (- end beg))
 625              (insert "#+end_example\n"))))))
 626
 627 (defun org-babel-merge-params (&rest plists)
 628   "Combine all parameter association lists in PLISTS.  Later
 629 elements of PLISTS override the values of previous element.  This
 630 takes into account some special considerations for certain
 631 parameters when merging lists."
 632   (let (params results exports tangle vars var ref)
 633     (flet ((e-merge (exclusive-groups &rest result-params)
 634                     ;; maintain exclusivity of mutually exclusive parameters
 635                     (let (output)
 636                       (mapc (lambda (new-params)
 637                               (mapc (lambda (new-param)
 638                                       (mapc (lambda (exclusive-group)
 639                                               (when (member new-param exclusive-group)
 640                                                 (mapcar (lambda (excluded-param)
 641                                                           (setq output (delete excluded-param output)))
 642                                                         exclusive-group)))
 643                                             exclusive-groups)
 644                                       (setq output (org-uniquify (cons new-param output))))
 645                                     new-params))
 646                             result-params)
 647                       output)))
 648       (mapc (lambda (plist)
 649               (mapc (lambda (pair)
 650                       (case (car pair)
 651                         (:var
 652                          ;; we want only one specification per variable
 653                          (when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair))
 654                            ;; TODO: When is this not true?
 655                            (setq var (intern (match-string 1 (cdr pair)))
 656                                  ref (match-string 2 (cdr pair))
 657                                  vars (cons (cons var ref) (assq-delete-all var vars)))))
 658                         (:results
 659                          (setq results (e-merge
 660                                         '(("file" "vector" "scalar" "raw" "org" "html" "latex")
 661                                           ("replace" "silent")
 662                                           ("output" "value"))
 663                                         results (split-string (cdr pair)))))
 664                         (:exports
 665                          (setq exports (e-merge '(("code" "results" "both"))
 666                                                 exports (split-string (cdr pair)))))
 667                         (:tangle
 668                          (setq tangle (e-merge '(("yes" "no"))
 669                                                tangle (split-string (cdr pair)))))
 670                         (t ;; replace: this covers e.g. :session
 671                          (setq params (cons pair (assq-delete-all (car pair) params))))))
 672                     plist))
 673             plists))
 674     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
 675     (while vars (setq params (cons (cons :var (pop vars)) params)))
 676     (cons (cons :tangle (mapconcat 'identity tangle " "))
 677           (cons (cons :exports (mapconcat 'identity exports " "))
 678                 (cons (cons :results (mapconcat 'identity results " "))
 679                       params)))))
 680
 681 (defun org-babel-clean-text-properties (text)
 682   "Strip all properties from text return."
 683   (set-text-properties 0 (length text) nil text) text)
 684
 685 (defun org-babel-strip-protective-commas (body)
 686   "Strip protective commas from bodies of source blocks."
 687   (replace-regexp-in-string "^,#" "#" body))
 688
 689 (defun org-babel-read (cell)
 690   "Convert the string value of CELL to a number if appropriate.
 691 Otherwise if cell looks like lisp (meaning it starts with a
 692 \"(\" or a \"'\") then read it as lisp, otherwise return it
 693 unmodified as a string.
 694
 695 This is taken almost directly from `org-read-prop'."
 696   (if (and (stringp cell) (not (equal cell "")))
 697       (or (org-babel-number-p cell)
 698           (if (or (equal "(" (substring cell 0 1))
 699                   (equal "'" (substring cell 0 1)))
 700               (read cell)
 701             (progn (set-text-properties 0 (length cell) nil cell) cell)))
 702     cell))
 703
 704 (defun org-babel-number-p (string)
 705   "Return t if STRING represents a number"
 706   (if (and (string-match "^[[:digit:]]*\\.?[[:digit:]]*$" string)
 707            (= (match-end 0) (length string)))
 708       (string-to-number string)))
 709
 710 (defun org-babel-import-elisp-from-file (file-name)
 711   "Read the results located at FILE-NAME into an elisp table.  If
 712 the table is trivial, then return it as a scalar."
 713   (let (result)
 714     (with-temp-buffer
 715       (condition-case nil
 716           (progn
 717             (org-table-import file-name nil)
 718             (delete-file file-name)
 719             (setq result (mapcar (lambda (row)
 720                                    (mapcar #'org-babel-string-read row))
 721                                  (org-table-to-lisp))))
 722         (error nil)))
 723     (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
 724         (if (consp (car result))
 725             (if (null (cdr (car result)))
 726                 (caar result)
 727               result)
 728           (car result))
 729       result)))
 730
 731 (defun org-babel-string-read (cell)
 732   "Strip nested \"s from around strings in exported R values."
 733   (org-babel-read (or (and (stringp cell)
 734                            (string-match "\\\"\\(.+\\)\\\"" cell)
 735                            (match-string 1 cell))
 736                       cell)))
 737
 738 (defun org-babel-reverse-string (string)
 739   (apply 'string (reverse (string-to-list string))))
 740
 741 (defun org-babel-chomp (string &optional regexp)
 742   "Remove any trailing space or carriage returns characters from
 743 STRING.  Default regexp used is \"[ \f\t\n\r\v]\" but can be
 744 overwritten by specifying a regexp as a second argument."
 745   (while (and (> (length string) 0) (string-match "[ \f\t\n\r\v]" (substring string -1)))
 746     (setq string (substring string 0 -1)))
 747   string)
 748
 749 (defun org-babel-trim (string &optional regexp)
 750   "Like `org-babel-chomp' only it runs on both the front and back of the string"
 751   (org-babel-chomp (org-babel-reverse-string
 752                     (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
 753
 754 (provide 'org-babel)
 755 ;;; org-babel.el ends here