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 (defun org-babel-pop-to-session-maybe ()
  44   "Detect if this is context for a org-babel src-block and if so
  45 then run `org-babel-pop-to-session'."
  46   (interactive)
  47   (let ((info (org-babel-get-src-block-info)))
  48     (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
  49
  50 (add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
  51
  52 (defvar org-babel-default-header-args '((:session . "none") (:results . "replace"))
  53   "Default arguments to use when evaluating a source block.")
  54
  55 (defvar org-babel-default-inline-header-args '((:results . "silent") (:exports . "code"))
  56   "Default arguments to use when evaluating an inline source block.")
  57
  58 (defvar org-babel-src-block-regexp nil
  59   "Regexp used to test when inside of a org-babel src-block")
  60
  61 (defvar org-babel-inline-src-block-regexp nil
  62   "Regexp used to test when on an inline org-babel src-block")
  63
  64 (defvar org-babel-min-lines-for-block-output 10
  65   "If number of lines of output is equal to or exceeds this
  66   value, the output is placed in a
  67   #+begin_example...#+end_example block. Otherwise the output is
  68   marked as literal by inserting colons at the starts of the
  69   lines. This variable only takes effect if the :results output
  70   option is in effect.")
  71
  72 (defun org-babel-named-src-block-regexp-for-name (name)
  73   "Regexp used to match named src block."
  74   (concat "#\\+srcname:[ \t]*" (regexp-quote name) "[ \t\n]*"
  75           org-babel-src-block-regexp))
  76
  77 (defun org-babel-set-interpreters (var value)
  78   (set-default var value)
  79   (setq org-babel-src-block-regexp
  80         (concat "#\\+begin_src \\("
  81                 (mapconcat 'regexp-quote value "\\|")
  82                 "\\)[ \t]*"
  83                 "\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments
  84                 "\\([^\000]+?\\)#\\+end_src"))
  85   (setq org-babel-inline-src-block-regexp
  86         (concat "src_\\("
  87                 (mapconcat 'regexp-quote value "\\|")
  88                 "\\)"
  89                 "\\(\\|\\[\\(.*\\)\\]\\)"
  90                 "{\\([^\n]+\\)}")))
  91
  92 (defun org-babel-add-interpreter (interpreter)
  93   "Add INTERPRETER to `org-babel-interpreters' and update
  94 `org-babel-src-block-regexp' appropriately."
  95   (unless (member interpreter org-babel-interpreters)
  96     (setq org-babel-interpreters (cons interpreter org-babel-interpreters))
  97     ;; (add-to-list 'org-babel-session-defaults (cons interpreter (format "org-babel-%s" interpreter)))
  98     (org-babel-set-interpreters 'org-babel-interpreters org-babel-interpreters)))
  99
 100 (defcustom org-babel-interpreters '()
 101   "Interpreters allows for evaluation tags.
 102 This is a list of program names (as strings) that can evaluate code and
 103 insert the output into an Org-mode buffer.  Valid choices are
 104
 105 R          Evaluate R code
 106 emacs-lisp Evaluate Emacs Lisp code and display the result
 107 sh         Pass command to the shell and display the result
 108 perl       The perl interpreter
 109 python     The python interpreter
 110 ruby       The ruby interpreter
 111
 112 The source block regexp `org-babel-src-block-regexp' is updated
 113 when a new interpreter is added to this list through the
 114 customize interface.  To add interpreters to this variable from
 115 lisp code use the `org-babel-add-interpreter' function."
 116   :group 'org-babel
 117   :set 'org-babel-set-interpreters
 118   :type '(set :greedy t
 119               (const "R")
 120               (const "emacs-lisp")
 121               (const "sh")
 122               (const "perl")
 123               (const "python")
 124               (const "ruby")))
 125
 126 ;;; functions
 127 (defun org-babel-pop-to-session (&optional arg info)
 128   "Pop to the session of the current source-code block.  If
 129 called with a prefix argument then evaluate the header arguments
 130 for the source block before entering the session.  Copy the body
 131 of the source block to the kill ring."
 132   (interactive)
 133   (let* ((info (or info (org-babel-get-src-block-info)))
 134          (lang (first info))
 135          (body (second info))
 136          (params (third info))
 137          (session (cdr (assoc :session params))))
 138     (unless (member lang org-babel-interpreters)
 139       (error "Language is not in `org-babel-interpreters': %s" lang))
 140     ;; copy body to the kill ring
 141     (with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max)))
 142     ;; if called with a prefix argument, then process header arguments
 143     (if arg (funcall (intern (concat "org-babel-prep-session:" lang)) session params))
 144     ;; just to the session using pop-to-buffer
 145     (pop-to-buffer (funcall (intern (format "org-babel-%s-initiate-session" lang)) session))
 146     (move-end-of-line 1)))
 147
 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)
 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-process-value-result (result result-params)
 185   "Process returned value for insertion in buffer.
 186
 187 Currently, this function forces to table output if :results
 188 vector has been supplied.
 189
 190   You can see below the various fragments of results-processing
 191 code that were present in the language-specific files. Out of
 192 those fragments, I've moved the org-babel-python-table-or-results
 193 and org-babel-import-elisp-from-file functionality into the
 194 org-babel-*-evaluate functions. I think those should only be used
 195 in the :results value case, as in the 'output case we are not
 196 concerned with creating elisp versions of results. "
 197
 198   (if (and (member "vector" result-params) (not (listp result)))
 199       (list (list result))
 200          result))
 201
 202 (defun org-babel-execute-buffer (&optional arg)
 203   "Replace EVAL snippets in the entire buffer."
 204   (interactive "P")
 205   (save-excursion
 206     (goto-char (point-min))
 207     (while (re-search-forward org-babel-src-block-regexp nil t)
 208       (goto-char (match-beginning 0))
 209       (org-babel-execute-src-block arg)
 210       (goto-char (match-end 0)))))
 211
 212 (defun org-babel-execute-subtree (&optional arg)
 213   "Replace EVAL snippets in the entire subtree."
 214   (interactive "P")
 215   (save-excursion
 216     (org-narrow-to-subtree)
 217     (org-babel-execute-buffer)
 218     (widen)))
 219
 220 (defun org-babel-get-src-block-name ()
 221   "Return the name of the current source block if one exists.
 222
 223 This function is analogous to org-babel-lob-get-info. For both
 224 functions, after they are called, (match-string 1) matches the
 225 function name, and (match-string 2) matches the function
 226 arguments inside the parentheses. I think perhaps these functions
 227 should be renamed to bring out this similarity, perhaps involving
 228 the word 'call'."
 229   (let ((case-fold-search t)
 230         (head (org-babel-where-is-src-block-head)))
 231     (if head
 232         (save-excursion
 233           (goto-char head)
 234           (if (save-excursion
 235                 (forward-line -1)
 236                 (looking-at "#\\+srcname:[ \f\t\n\r\v]*\\([^ ()\f\t\n\r\v]+\\)\(\\(.*\\)\)"))
 237               (org-babel-clean-text-properties (match-string 1)))))))
 238
 239 (defun org-babel-get-src-block-info ()
 240   "Return the information of the current source block as a list
 241 of the following form.  (language body header-arguments-alist)"
 242   (let ((case-fold-search t) head)
 243     (if (setq head (org-babel-where-is-src-block-head))
 244         (save-excursion (goto-char head) (org-babel-parse-src-block-match))
 245       (if (save-excursion ;; inline source block
 246             (re-search-backward "[ \f\t\n\r\v]" nil t)
 247             (forward-char 1)
 248             (looking-at org-babel-inline-src-block-regexp))
 249           (org-babel-parse-inline-src-block-match)
 250         nil)))) ;; indicate that no source block was found
 251
 252 (defun org-babel-get-src-block-function-args ()
 253   (when (org-babel-get-src-block-name)
 254     (mapcar (lambda (ref) (cons :var ref))
 255             (split-string (org-babel-clean-text-properties (match-string 2))
 256                           ",[ \f\t\n\r\v]*"))))
 257
 258 (defmacro org-babel-map-source-blocks (file &rest body)
 259   "Evaluate BODY forms on each source-block in FILE."
 260   (declare (indent 1))
 261   `(save-window-excursion
 262      (find-file ,file) (goto-char (point-min))
 263      (while (re-search-forward org-babel-src-block-regexp nil t)
 264        (goto-char (match-beginning 0))
 265        (save-match-data ,@body)
 266        (goto-char (match-end 0)))))
 267
 268 (defun org-babel-parse-src-block-match ()
 269   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 270          (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
 271     (list lang
 272           (org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 4)))
 273           (org-babel-merge-params
 274            org-babel-default-header-args
 275            (if (boundp lang-headers) (eval lang-headers) nil)
 276            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 277
 278 (defun org-babel-parse-inline-src-block-match ()
 279   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 280          (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
 281     (list lang
 282           (org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 4)))
 283           (org-babel-merge-params
 284            org-babel-default-inline-header-args
 285            (if (boundp lang-headers) (eval lang-headers) nil)
 286            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 287
 288 (defun org-babel-parse-header-arguments (arg-string)
 289   "Parse a string of header arguments returning an alist."
 290   (if (> (length arg-string) 0)
 291       (delq nil
 292             (mapcar
 293              (lambda (arg)
 294                (if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg)
 295                    (cons (intern (concat ":" (match-string 1 arg)))
 296                          (org-babel-chomp (match-string 2 arg)))
 297                  (cons (intern (concat ":" arg)) nil)))
 298              (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
 299
 300 (defun org-babel-process-params (params)
 301   "Parse params and resolve references.
 302
 303 Return a list (session vars result-params result-type). These are
 304 made available to the org-babel-execute:LANG functions via
 305 multiple-value-bind."
 306   (let* ((session (cdr (assoc :session params)))
 307          (vars (org-babel-ref-variables params))
 308          (result-params (split-string (or (cdr (assoc :results params)) "")))
 309          (result-type (cond ((member "output" result-params) 'output)
 310                             ((member "value" result-params) 'value)
 311                             (t 'value))))
 312     (list session vars result-params result-type)))
 313
 314 (defun org-babel-where-is-src-block-head ()
 315   "Return the point at the beginning of the current source
 316 block.  Specifically at the beginning of the #+BEGIN_SRC line.
 317 If the point is not on a source block then return nil."
 318   (let ((initial (point)) top bottom)
 319     (or
 320      (save-excursion ;; on a #+srcname: line
 321        (beginning-of-line 1)
 322        (and (looking-at "#\\+srcname") (forward-line 1)
 323             (looking-at org-babel-src-block-regexp)
 324             (point)))
 325      (save-excursion ;; on a #+begin_src line
 326        (beginning-of-line 1)
 327        (and (looking-at org-babel-src-block-regexp)
 328             (point)))
 329      (save-excursion ;; inside a src block
 330        (and
 331         (re-search-backward "#\\+begin_src" nil t) (setq top (point))
 332         (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
 333         (< top initial) (< initial bottom)
 334         (goto-char top) (looking-at org-babel-src-block-regexp)
 335         (point))))))
 336
 337 (defun org-babel-goto-named-source-block (&optional name)
 338   "Go to a named source-code block."
 339   (interactive "ssource-block name: ")
 340   (let ((point (org-babel-find-named-block name)))
 341     (if point
 342         ;; taken from `org-open-at-point'
 343         (progn (goto-char point) (org-show-context))
 344       (message "source-code block '%s' not found in this buffer" name))))
 345
 346 (defun org-babel-find-named-block (name)
 347   "Find a named source-code block.
 348 Return the location of the source block identified by
 349 #+srcname NAME, or nil if no such block exists. Set match data
 350 according to org-babel-named-src-block-regexp."
 351   (save-excursion
 352     (let ((case-fold-search t)
 353           (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
 354       (goto-char (point-min))
 355       (when (or (re-search-forward regexp nil t)
 356                 (re-search-backward regexp nil t))
 357         (match-beginning 0)))))
 358
 359 (defun org-babel-find-named-result (name)
 360   "Return the location of the result named NAME in the current
 361 buffer or nil if no such result exists."
 362   (save-excursion
 363     (goto-char (point-min))
 364     (when (re-search-forward ;; ellow end-of-buffer in following regexp?
 365            (concat "#\\+resname:[ \t]*" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
 366       (move-beginning-of-line 1) (point))))
 367
 368 (defun org-babel-where-is-src-block-result ()
 369   "Return the point at the beginning of the result of the current
 370 source block.  Specifically at the beginning of the #+RESNAME:
 371 line.  If no result exists for this block then create a
 372 #+RESNAME: line following the source block."
 373   (save-excursion
 374     (let* ((on-lob-line (progn (beginning-of-line 1)
 375                                (looking-at org-babel-lob-one-liner-regexp)))
 376            (name (if on-lob-line (org-babel-lob-get-info) (org-babel-get-src-block-name)))
 377            (head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
 378       (when head (goto-char head))
 379       (or (and name (message name) (org-babel-find-named-result name))
 380           (and (or on-lob-line (re-search-forward "#\\+end_src" nil t))
 381                (progn (move-end-of-line 1)
 382                       (if (eobp) (insert "\n") (forward-char 1))
 383                       (setq end (point))
 384                       (or (progn ;; either an unnamed #+resname: line already exists
 385                             (re-search-forward "[^ \f\t\n\r\v]" nil t)
 386                             (move-beginning-of-line 1) (looking-at "#\\+resname:"))
 387                           (progn ;; or we need to back up and make one ourselves
 388                             (goto-char end) (open-line 2) (forward-char 1)
 389                             (insert (concat "#+resname:" (if name (concat " " name))))
 390                             (move-beginning-of-line 1) t)))
 391                (point))))))
 392
 393 (defun org-babel-insert-result (result &optional insert)
 394   "Insert RESULT into the current buffer after the end of the
 395 current source block.  With optional argument INSERT controls
 396 insertion of results in the org-mode file.  INSERT can take the
 397 following values...
 398
 399 t ------ the default option, simply insert the results after the
 400          source block
 401
 402 replace - insert results after the source block replacing any
 403           previously inserted results
 404
 405 silent -- no results are inserted"
 406   (if (stringp result)
 407       (progn
 408         (setq result (org-babel-clean-text-properties result))
 409         (if (member "file" insert) (setq result (org-babel-result-to-file result))))
 410     (unless (listp result) (setq result (format "%S" result))))
 411   (if (and insert (member "replace" insert) (not (member "silent" insert)))
 412       (org-babel-remove-result))
 413   (if (= (length result) 0)
 414       (if (member "value" result-params)
 415           (message "No result returned by source block")
 416         (message "Source block produced no output"))
 417     (if (and insert (member "silent" insert))
 418         (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
 419       (when (and (stringp result) ;; ensure results end in a newline
 420                  (not (or (string-equal (substring result -1) "\n")
 421                           (string-equal (substring result -1) "\r"))))
 422         (setq result (concat result "\n")))
 423       (save-excursion
 424         (let ((existing-result (org-babel-where-is-src-block-result)))
 425           (when existing-result (goto-char existing-result) (forward-line 1)))
 426         (if (stringp result) ;; assume the result is a table if it's not a string
 427             (if (member "file" insert)
 428                 (insert result)
 429               (org-babel-examplize-region (point) (progn (insert result) (point))))
 430           (progn
 431             (insert
 432              (concat (orgtbl-to-orgtbl
 433                       (if (consp (car result)) result (list result))
 434                       '(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
 435             (forward-line -1)
 436             (org-cycle))))
 437       (message "finished"))))
 438
 439 (defun org-babel-result-to-org-string (result)
 440   "Return RESULT as a string in org-mode format.  This function
 441 relies on `org-babel-insert-result'."
 442   (with-temp-buffer (org-babel-insert-result result) (buffer-string)))
 443
 444 (defun org-babel-remove-result ()
 445   "Remove the result of the current source block."
 446   (interactive)
 447   (save-excursion
 448     (goto-char (org-babel-where-is-src-block-result)) (forward-line 1)
 449     (delete-region (point) (org-babel-result-end))))
 450
 451 (defun org-babel-result-end ()
 452   "Return the point at the end of the current set of results"
 453   (save-excursion
 454     (if (org-at-table-p)
 455         (org-table-end)
 456       (let ((case-fold-search nil))
 457         (if (looking-at-p "#\\+begin_example")
 458             (search-forward "#+end_example" nil t)
 459           (progn
 460             (while (if (looking-at "\\(: \\|\\[\\[\\)")
 461                        (progn (while (looking-at "\\(: \\|\\[\\[\\)")
 462                                 (forward-line 1)) t))
 463               (forward-line 1))
 464             (forward-line -1))))
 465       (point))))
 466
 467 (defun org-babel-result-to-file (result)
 468   "Return an `org-mode' link with the path being the value or
 469 RESULT, and the display being the `file-name-nondirectory' if
 470 non-nil."
 471   (let ((name (file-name-nondirectory result)))
 472     (concat "[[file:" result (if name (concat "][" name "]]") "]]"))))
 473
 474 (defun org-babel-examplize-region (beg end)
 475   "Comment out region using the ': ' org example quote."
 476   (interactive "*r")
 477   (let ((size (abs (- (line-number-at-pos end)
 478                       (line-number-at-pos beg)))))
 479     (save-excursion
 480       (cond ((= size 0)
 481              (error "This should be impossible: a newline was appended to result if missing")
 482              (let ((result (buffer-substring beg end)))
 483                (delete-region beg end)
 484                (insert (concat ": " result))))
 485             ((< size org-babel-min-lines-for-block-output)
 486              (goto-char beg)
 487              (dotimes (n size)
 488                (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
 489             (t
 490              (goto-char beg)
 491              (insert "#+begin_example\n")
 492              (forward-char (- end beg))
 493              (insert "#+end_example\n"))))))
 494
 495 (defun org-babel-merge-params (&rest plists)
 496   "Combine all parameter association lists in PLISTS.  Later
 497 elements of PLISTS override the values of previous element.  This
 498 takes into account some special considerations for certain
 499 parameters when merging lists."
 500   (let (params results exports tangle vars var ref)
 501     (flet ((e-merge (exclusive-groups &rest result-params)
 502                     ;; maintain exclusivity of mutually exclusive parameters
 503                     (let (output)
 504                       (mapc (lambda (new-params)
 505                               (mapc (lambda (new-param)
 506                                       (mapc (lambda (exclusive-group)
 507                                               (when (member new-param exclusive-group)
 508                                                 (mapcar (lambda (excluded-param)
 509                                                           (setq output (delete excluded-param output)))
 510                                                         exclusive-group)))
 511                                             exclusive-groups)
 512                                       (setq output (org-uniquify (cons new-param output))))
 513                                     new-params))
 514                             result-params)
 515                       output)))
 516       (mapc (lambda (plist)
 517               (mapc (lambda (pair)
 518                       (case (car pair)
 519                         (:var
 520                          ;; we want only one specification per variable
 521                          (when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair))
 522                            ;; TODO: When is this not true?
 523                            (setq var (intern (match-string 1 (cdr pair)))
 524                                  ref (match-string 2 (cdr pair))
 525                                  vars (cons (cons var ref) (assq-delete-all var vars)))))
 526                         (:results
 527                          (setq results (e-merge '(("file" "vector" "scalar")
 528                                                   ("replace" "silent")
 529                                                   ("output" "value"))
 530                                                 results (split-string (cdr pair)))))
 531                         (:exports
 532                          (setq exports (e-merge '(("code" "results" "both"))
 533                                                 exports (split-string (cdr pair)))))
 534                         (:tangle
 535                          (setq tangle (e-merge '(("yes" "no"))
 536                                                tangle (split-string (cdr pair)))))
 537                         (t ;; replace: this covers e.g. :session
 538                          (setq params (cons pair (assq-delete-all (car pair) params))))))
 539                     plist))
 540             plists))
 541     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
 542     (while vars (setq params (cons (cons :var (pop vars)) params)))
 543     (cons (cons :tangle (mapconcat 'identity tangle " "))
 544           (cons (cons :exports (mapconcat 'identity exports " "))
 545                 (cons (cons :results (mapconcat 'identity results " "))
 546                       params)))))
 547
 548 (defun org-babel-clean-text-properties (text)
 549   "Strip all properties from text return."
 550   (set-text-properties 0 (length text) nil text) text)
 551
 552 (defun org-babel-strip-protective-commas (body)
 553   "Strip protective commas from bodies of source blocks."
 554   (replace-regexp-in-string "^,#" "#" body))
 555
 556 (defun org-babel-read (cell)
 557   "Convert the string value of CELL to a number if appropriate.
 558 Otherwise if cell looks like lisp (meaning it starts with a
 559 \"(\" or a \"'\") then read it as lisp, otherwise return it
 560 unmodified as a string.
 561
 562 This is taken almost directly from `org-read-prop'."
 563   (if (and (stringp cell) (not (equal cell "")))
 564       (or (org-babel-number-p cell)
 565           (if (or (equal "(" (substring cell 0 1))
 566                   (equal "'" (substring cell 0 1)))
 567               (read cell)
 568             (progn (set-text-properties 0 (length cell) nil cell) cell)))
 569     cell))
 570
 571 (defun org-babel-number-p (string)
 572   "Return t if STRING represents a number"
 573   (if (string-match "^[[:digit:]]*\\.?[[:digit:]]*$" string)
 574       (string-to-number string)))
 575
 576 (defun org-babel-import-elisp-from-file (file-name)
 577   "Read the results located at FILE-NAME into an elisp table.  If
 578 the table is trivial, then return it as a scalar."
 579   (let (result)
 580     (with-temp-buffer
 581       (condition-case nil
 582           (progn
 583             (org-table-import file-name nil)
 584             (delete-file file-name)
 585             (setq result (mapcar (lambda (row)
 586                                    (mapcar #'org-babel-string-read row))
 587                                  (org-table-to-lisp))))
 588         (error nil)))
 589     (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
 590         (if (consp (car result))
 591             (if (null (cdr (car result)))
 592                 (caar result)
 593               result)
 594           (car result))
 595       result)))
 596
 597 (defun org-babel-string-read (cell)
 598   "Strip nested \"s from around strings in exported R values."
 599   (org-babel-read (or (and (stringp cell)
 600                            (string-match "\\\"\\(.+\\)\\\"" cell)
 601                            (match-string 1 cell))
 602                       cell)))
 603
 604 (defun org-babel-reverse-string (string)
 605   (apply 'string (reverse (string-to-list string))))
 606
 607 (defun org-babel-chomp (string &optional regexp)
 608   "Remove any trailing space or carriage returns characters from
 609 STRING.  Default regexp used is \"[ \f\t\n\r\v]\" but can be
 610 overwritten by specifying a regexp as a second argument."
 611   (while (and (> (length string) 0) (string-match "[ \f\t\n\r\v]" (substring string -1)))
 612     (setq string (substring string 0 -1)))
 613   string)
 614
 615 (defun org-babel-trim (string &optional regexp)
 616   "Like `org-babel-chomp' only it runs on both the front and back of the string"
 617   (org-babel-chomp (org-babel-reverse-string
 618                     (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
 619
 620 (provide 'org-babel)
 621 ;;; org-babel.el ends here