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           org-babel-src-block-regexp))
  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 2) 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   (let ((case-fold-search t)
 280         (head (org-babel-where-is-src-block-head)))
 281     (if head
 282         (save-excursion
 283           (goto-char head)
 284           (if (save-excursion
 285                 (forward-line -1)
 286                 (looking-at "#\\+srcname:[ \f\t\n\r\v]*\\([^ ()\f\t\n\r\v]+\\)\(\\(.*\\)\)"))
 287               (org-babel-clean-text-properties (match-string 1)))))))
 288
 289 (defun org-babel-get-src-block-info ()
 290   "Return the information of the current source block as a list
 291 of the following form.  (language body header-arguments-alist)"
 292   (let ((case-fold-search t) head)
 293     (if (setq head (org-babel-where-is-src-block-head))
 294         (save-excursion (goto-char head) (org-babel-parse-src-block-match))
 295       (if (save-excursion ;; inline source block
 296             (re-search-backward "[ \f\t\n\r\v]" nil t)
 297             (forward-char 1)
 298             (looking-at org-babel-inline-src-block-regexp))
 299           (org-babel-parse-inline-src-block-match)
 300         nil)))) ;; indicate that no source block was found
 301
 302 (defun org-babel-get-src-block-function-args ()
 303   (when (org-babel-get-src-block-name)
 304     (mapcar (lambda (ref) (cons :var ref))
 305             (org-babel-ref-split-args (match-string 2)))))
 306
 307 (defmacro org-babel-map-source-blocks (file &rest body)
 308   "Evaluate BODY forms on each source-block in FILE."
 309   (declare (indent 1))
 310   `(let ((visited-p (get-buffer (file-name-nondirectory ,file))))
 311      (save-window-excursion
 312        (find-file ,file) (goto-char (point-min))
 313        (while (re-search-forward org-babel-src-block-regexp nil t)
 314          (goto-char (match-beginning 0))
 315          (save-match-data ,@body)
 316          (goto-char (match-end 0))))
 317      (unless visited-p (kill-buffer (file-name-nondirectory file)))))
 318
 319 (defun org-babel-params-from-properties ()
 320   "Return an association list of any source block params which
 321 may be specified in the properties of the current outline entry."
 322   (save-match-data
 323     (delq nil
 324           (mapcar
 325            (lambda (header-arg)
 326              (let ((val (org-entry-get (point) header-arg)))
 327                (when val
 328                  ;; (message "param-from-property %s=%s" header-arg val) ;; debugging statement
 329                  (cons (intern (concat ":" header-arg)) val))))
 330            '("results" "exports" "tangle" "var")))))
 331
 332 (defun org-babel-parse-src-block-match ()
 333   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 334          (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
 335          (body (org-babel-clean-text-properties (match-string 4))))
 336     (list lang
 337           (with-temp-buffer ;; get src block body removing properties, protective commas, and indentation
 338             (save-match-data
 339               (insert (org-babel-strip-protective-commas body))
 340               (org-do-remove-indentation)
 341               (buffer-string)))
 342           (org-babel-merge-params
 343            org-babel-default-header-args
 344            (org-babel-params-from-properties)
 345            (if (boundp lang-headers) (eval lang-headers) nil)
 346            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 347
 348 (defun org-babel-parse-inline-src-block-match ()
 349   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 350          (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
 351     (list lang
 352           (org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 4)))
 353           (org-babel-merge-params
 354            org-babel-default-inline-header-args
 355            (org-babel-params-from-properties)
 356            (if (boundp lang-headers) (eval lang-headers) nil)
 357            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
 358
 359 (defun org-babel-parse-header-arguments (arg-string)
 360   "Parse a string of header arguments returning an alist."
 361   (if (> (length arg-string) 0)
 362       (delq nil
 363             (mapcar
 364              (lambda (arg)
 365                (if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg)
 366                    (cons (intern (concat ":" (match-string 1 arg)))
 367                          (org-babel-chomp (match-string 2 arg)))
 368                  (cons (intern (concat ":" arg)) nil)))
 369              (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
 370
 371 (defun org-babel-process-params (params)
 372   "Parse params and resolve references.
 373
 374 Return a list (session vars result-params result-type). These are
 375 made available to the org-babel-execute:LANG functions via
 376 multiple-value-bind."
 377   (let* ((session (cdr (assoc :session params)))
 378          (vars (org-babel-ref-variables params))
 379          (result-params (split-string (or (cdr (assoc :results params)) "")))
 380          (result-type (cond ((member "output" result-params) 'output)
 381                             ((member "value" result-params) 'value)
 382                             (t 'value))))
 383     (list session vars result-params result-type)))
 384
 385 (defun org-babel-where-is-src-block-head ()
 386   "Return the point at the beginning of the current source
 387 block.  Specifically at the beginning of the #+BEGIN_SRC line.
 388 If the point is not on a source block then return nil."
 389   (let ((initial (point)) top bottom)
 390     (or
 391      (save-excursion ;; on a #+srcname: line
 392        (beginning-of-line 1)
 393        (and (looking-at "#\\+srcname") (forward-line 1)
 394             (looking-at org-babel-src-block-regexp)
 395             (point)))
 396      (save-excursion ;; on a #+begin_src line
 397        (beginning-of-line 1)
 398        (and (looking-at org-babel-src-block-regexp)
 399             (point)))
 400      (save-excursion ;; inside a src block
 401        (and
 402         (re-search-backward "#\\+begin_src" nil t) (setq top (point))
 403         (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
 404         (< top initial) (< initial bottom)
 405         (goto-char top) (looking-at org-babel-src-block-regexp)
 406         (point))))))
 407
 408 (defun org-babel-goto-named-source-block (&optional name)
 409   "Go to a named source-code block."
 410   (interactive "ssource-block name: ")
 411   (let ((point (org-babel-find-named-block name)))
 412     (if point
 413         ;; taken from `org-open-at-point'
 414         (progn (goto-char point) (org-show-context))
 415       (message "source-code block '%s' not found in this buffer" name))))
 416
 417 (defun org-babel-find-named-block (name)
 418   "Find a named source-code block.
 419 Return the location of the source block identified by
 420 #+srcname NAME, or nil if no such block exists. Set match data
 421 according to org-babel-named-src-block-regexp."
 422   (save-excursion
 423     (let ((case-fold-search t)
 424           (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
 425       (goto-char (point-min))
 426       (when (or (re-search-forward regexp nil t)
 427                 (re-search-backward regexp nil t))
 428         (match-beginning 0)))))
 429
 430 (defun org-babel-find-named-result (name)
 431   "Return the location of the result named NAME in the current
 432 buffer or nil if no such result exists."
 433   (save-excursion
 434     (goto-char (point-min))
 435     (when (re-search-forward ;; ellow end-of-buffer in following regexp?
 436            (concat "#\\+resname:[ \t]*" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
 437       (move-beginning-of-line 1) (point))))
 438
 439 (defun org-babel-where-is-src-block-result (&optional insert)
 440   "Return the point at the beginning of the result of the current
 441 source block.  Specifically at the beginning of the #+RESNAME:
 442 line.  If no result exists for this block then create a
 443 #+RESNAME: line following the source block."
 444   (save-excursion
 445     (let* ((on-lob-line (progn (beginning-of-line 1)
 446                                (looking-at org-babel-lob-one-liner-regexp)))
 447            (name (if on-lob-line (org-babel-lob-get-info) (org-babel-get-src-block-name)))
 448            (head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
 449       (when head (goto-char head))
 450       (or (and name (message name) (org-babel-find-named-result name))
 451           (and (or on-lob-line (re-search-forward "#\\+end_src" nil t))
 452                (progn (move-end-of-line 1)
 453                       (if (eobp) (insert "\n") (forward-char 1))
 454                       (setq end (point))
 455                       (or (progn ;; either an unnamed #+resname: line already exists
 456                             (re-search-forward "[^ \f\t\n\r\v]" nil t)
 457                             (move-beginning-of-line 1) (looking-at "#\\+resname:"))
 458                           (when insert ;; or (with optional insert) we need to back up and make one ourselves
 459                             (goto-char end) (open-line 2) (forward-char 1)
 460                             (insert (concat "#+resname:" (if name (concat " " name))))
 461                             (move-beginning-of-line 1) t)))
 462                (point))))))
 463
 464 (defun org-babel-read-result ()
 465   "Read the result at `point' into emacs-lisp."
 466   (cond
 467    ((org-at-table-p) (org-babel-read-table))
 468    ((looking-at ": ")
 469     (let ((result-string
 470            (org-babel-trim
 471             (mapconcat (lambda (line) (if (and (> (length line) 1)
 472                                                (string= ": " (substring line 0 2)))
 473                                           (substring line 2)
 474                                         line))
 475                        (split-string
 476                         (buffer-substring (point) (org-babel-result-end)) "[\r\n]+")
 477                        "\n"))))
 478       (or (org-babel-number-p result-string) result-string)))
 479    ((looking-at "^#\\+RESNAME:")
 480     (save-excursion (forward-line 1) (org-babel-read-result)))))
 481
 482 (defun org-babel-read-table ()
 483   "Read the table at `point' into emacs-lisp."
 484   (mapcar (lambda (row)
 485             (if (and (symbolp row) (equal row 'hline)) row
 486               (mapcar #'org-babel-read row)))
 487           (org-table-to-lisp)))
 488
 489 (defun org-babel-insert-result (result &optional insert)
 490   "Insert RESULT into the current buffer after the end of the
 491 current source block.  With optional argument INSERT controls
 492 insertion of results in the org-mode file.  INSERT can take the
 493 following values...
 494
 495 t ------ the default option, simply insert the results after the
 496          source block
 497
 498 replace - insert results after the source block replacing any
 499           previously inserted results
 500
 501 silent -- no results are inserted"
 502   (if (stringp result)
 503       (progn
 504         (setq result (org-babel-clean-text-properties result))
 505         (if (member "file" insert) (setq result (org-babel-result-to-file result))))
 506     (unless (listp result) (setq result (format "%S" result))))
 507   (if (and insert (member "replace" insert) (not (member "silent" insert)))
 508       (org-babel-remove-result))
 509   (if (= (length result) 0)
 510       (if (member "value" result-params)
 511           (message "No result returned by source block")
 512         (message "Source block produced no output"))
 513     (if (and insert (member "silent" insert))
 514         (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
 515       (when (and (stringp result) ;; ensure results end in a newline
 516                  (not (or (string-equal (substring result -1) "\n")
 517                           (string-equal (substring result -1) "\r"))))
 518         (setq result (concat result "\n")))
 519       (save-excursion
 520         (let ((existing-result (org-babel-where-is-src-block-result t)))
 521           (when existing-result (goto-char existing-result) (forward-line 1)))
 522         (if (stringp result) ;; assume the result is a table if it's not a string
 523             (if (member "file" insert)
 524                 (insert result)
 525               (if (or (member "raw" insert) (member "org" insert))
 526                   (progn (save-excursion (insert result))
 527                          (if (org-at-table-p) (org-cycle)))
 528                 (org-babel-examplize-region (point) (progn (insert result) (point)))))
 529           (progn
 530             (insert
 531              (concat (orgtbl-to-orgtbl
 532                       (if (consp (car result)) result (list result))
 533                       '(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
 534             (forward-line -1)
 535             (org-cycle))))
 536       (message "finished"))))
 537
 538 (defun org-babel-result-to-org-string (result)
 539   "Return RESULT as a string in org-mode format.  This function
 540 relies on `org-babel-insert-result'."
 541   (with-temp-buffer (org-babel-insert-result result) (buffer-string)))
 542
 543 (defun org-babel-remove-result ()
 544   "Remove the result of the current source block."
 545   (interactive)
 546   (save-excursion
 547     (goto-char (org-babel-where-is-src-block-result t)) (forward-line 1)
 548     (delete-region (point) (org-babel-result-end))))
 549
 550 (defun org-babel-result-end ()
 551   "Return the point at the end of the current set of results"
 552   (save-excursion
 553     (if (org-at-table-p)
 554         (org-table-end)
 555       (let ((case-fold-search nil))
 556         (if (looking-at "#\\+begin_example")
 557             (search-forward "#+end_example" nil t)
 558           (progn
 559             (while (if (looking-at "\\(: \\|\\[\\[\\)")
 560                        (progn (while (looking-at "\\(: \\|\\[\\[\\)")
 561                                 (forward-line 1)) t))
 562               (forward-line 1))
 563             (forward-line -1))))
 564       (point))))
 565
 566 (defun org-babel-result-to-file (result)
 567   "Return an `org-mode' link with the path being the value or
 568 RESULT, and the display being the `file-name-nondirectory' if
 569 non-nil."
 570   (let ((name (file-name-nondirectory result)))
 571     (concat "[[file:" result (if name (concat "][" name "]]") "]]"))))
 572
 573 (defun org-babel-examplize-region (beg end)
 574   "Comment out region using the ': ' org example quote."
 575   (interactive "*r")
 576   (let ((size (abs (- (line-number-at-pos end)
 577                       (line-number-at-pos beg)))))
 578     (save-excursion
 579       (cond ((= size 0)
 580              (error "This should be impossible: a newline was appended to result if missing")
 581              (let ((result (buffer-substring beg end)))
 582                (delete-region beg end)
 583                (insert (concat ": " result))))
 584             ((< size org-babel-min-lines-for-block-output)
 585              (goto-char beg)
 586              (dotimes (n size)
 587                (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
 588             (t
 589              (goto-char beg)
 590              (insert "#+begin_example\n")
 591              (forward-char (- end beg))
 592              (insert "#+end_example\n"))))))
 593
 594 (defun org-babel-merge-params (&rest plists)
 595   "Combine all parameter association lists in PLISTS.  Later
 596 elements of PLISTS override the values of previous element.  This
 597 takes into account some special considerations for certain
 598 parameters when merging lists."
 599   (let (params results exports tangle vars var ref)
 600     (flet ((e-merge (exclusive-groups &rest result-params)
 601                     ;; maintain exclusivity of mutually exclusive parameters
 602                     (let (output)
 603                       (mapc (lambda (new-params)
 604                               (mapc (lambda (new-param)
 605                                       (mapc (lambda (exclusive-group)
 606                                               (when (member new-param exclusive-group)
 607                                                 (mapcar (lambda (excluded-param)
 608                                                           (setq output (delete excluded-param output)))
 609                                                         exclusive-group)))
 610                                             exclusive-groups)
 611                                       (setq output (org-uniquify (cons new-param output))))
 612                                     new-params))
 613                             result-params)
 614                       output)))
 615       (mapc (lambda (plist)
 616               (mapc (lambda (pair)
 617                       (case (car pair)
 618                         (:var
 619                          ;; we want only one specification per variable
 620                          (when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair))
 621                            ;; TODO: When is this not true?
 622                            (setq var (intern (match-string 1 (cdr pair)))
 623                                  ref (match-string 2 (cdr pair))
 624                                  vars (cons (cons var ref) (assq-delete-all var vars)))))
 625                         (:results
 626                          (setq results (e-merge '(("file" "vector" "scalar")
 627                                                   ("replace" "silent")
 628                                                   ("output" "value"))
 629                                                 results (split-string (cdr pair)))))
 630                         (:exports
 631                          (setq exports (e-merge '(("code" "results" "both"))
 632                                                 exports (split-string (cdr pair)))))
 633                         (:tangle
 634                          (setq tangle (e-merge '(("yes" "no"))
 635                                                tangle (split-string (cdr pair)))))
 636                         (t ;; replace: this covers e.g. :session
 637                          (setq params (cons pair (assq-delete-all (car pair) params))))))
 638                     plist))
 639             plists))
 640     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
 641     (while vars (setq params (cons (cons :var (pop vars)) params)))
 642     (cons (cons :tangle (mapconcat 'identity tangle " "))
 643           (cons (cons :exports (mapconcat 'identity exports " "))
 644                 (cons (cons :results (mapconcat 'identity results " "))
 645                       params)))))
 646
 647 (defun org-babel-clean-text-properties (text)
 648   "Strip all properties from text return."
 649   (set-text-properties 0 (length text) nil text) text)
 650
 651 (defun org-babel-strip-protective-commas (body)
 652   "Strip protective commas from bodies of source blocks."
 653   (replace-regexp-in-string "^,#" "#" body))
 654
 655 (defun org-babel-read (cell)
 656   "Convert the string value of CELL to a number if appropriate.
 657 Otherwise if cell looks like lisp (meaning it starts with a
 658 \"(\" or a \"'\") then read it as lisp, otherwise return it
 659 unmodified as a string.
 660
 661 This is taken almost directly from `org-read-prop'."
 662   (if (and (stringp cell) (not (equal cell "")))
 663       (or (org-babel-number-p cell)
 664           (if (or (equal "(" (substring cell 0 1))
 665                   (equal "'" (substring cell 0 1)))
 666               (read cell)
 667             (progn (set-text-properties 0 (length cell) nil cell) cell)))
 668     cell))
 669
 670 (defun org-babel-number-p (string)
 671   "Return t if STRING represents a number"
 672   (if (string-match "^[[:digit:]]*\\.?[[:digit:]]*$" string)
 673       (string-to-number string)))
 674
 675 (defun org-babel-import-elisp-from-file (file-name)
 676   "Read the results located at FILE-NAME into an elisp table.  If
 677 the table is trivial, then return it as a scalar."
 678   (let (result)
 679     (with-temp-buffer
 680       (condition-case nil
 681           (progn
 682             (org-table-import file-name nil)
 683             (delete-file file-name)
 684             (setq result (mapcar (lambda (row)
 685                                    (mapcar #'org-babel-string-read row))
 686                                  (org-table-to-lisp))))
 687         (error nil)))
 688     (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
 689         (if (consp (car result))
 690             (if (null (cdr (car result)))
 691                 (caar result)
 692               result)
 693           (car result))
 694       result)))
 695
 696 (defun org-babel-string-read (cell)
 697   "Strip nested \"s from around strings in exported R values."
 698   (org-babel-read (or (and (stringp cell)
 699                            (string-match "\\\"\\(.+\\)\\\"" cell)
 700                            (match-string 1 cell))
 701                       cell)))
 702
 703 (defun org-babel-reverse-string (string)
 704   (apply 'string (reverse (string-to-list string))))
 705
 706 (defun org-babel-chomp (string &optional regexp)
 707   "Remove any trailing space or carriage returns characters from
 708 STRING.  Default regexp used is \"[ \f\t\n\r\v]\" but can be
 709 overwritten by specifying a regexp as a second argument."
 710   (while (and (> (length string) 0) (string-match "[ \f\t\n\r\v]" (substring string -1)))
 711     (setq string (substring string 0 -1)))
 712   string)
 713
 714 (defun org-babel-trim (string &optional regexp)
 715   "Like `org-babel-chomp' only it runs on both the front and back of the string"
 716   (org-babel-chomp (org-babel-reverse-string
 717                     (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
 718
 719 (provide 'org-babel)
 720 ;;; org-babel.el ends here