contrib/babel/lisp/org-babel.el

   1 ;;; org-babel.el --- facilitating communication between programming languages and people
   2
   3 ;; Copyright (C) 2009 Eric Schulte, Dan Davison
   4
   5 ;; Author: Eric Schulte, Dan Davison
   6 ;; Keywords: literate programming, reproducible research
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 0.01
   9
  10 ;;; License:
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; See org-babel.org in the parent directory for more information
  30
  31 ;;; Code:
  32 (require 'org)
  33
  34 (defun org-babel-execute-src-block-maybe ()
  35   "Detect if this is context for a org-babel src-block and if so
  36 then run `org-babel-execute-src-block'."
  37   (interactive)
  38   (let ((info (org-babel-get-src-block-info)))
  39     (if info (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)))
  40
  41 (add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe)
  42
  43 (defadvice org-edit-special (around org-babel-prep-session-for-edit activate)
  44   "Prepare the current source block's session according to it's
  45 header arguments before editing in an org-src buffer.  This
  46 function is called when `org-edit-special' is called with a
  47 prefix argument from inside of a source-code block."
  48   (when current-prefix-arg
  49     (let* ((info (org-babel-get-src-block-info))
  50            (lang (first info))
  51            (params (third info))
  52            (session (cdr (assoc :session params))))
  53       (when (and info session) ;; if we are in a source-code block which has a session
  54         (funcall (intern (concat "org-babel-prep-session:" lang)) session params))))
  55   ad-do-it)
  56
  57 (defadvice org-open-at-point (around org-babel-open-at-point activate)
  58   "If `point' is on a source code block, then open that block's
  59 results with `org-babel-open-src-block-results', otherwise defer
  60 to `org-open-at-point'."
  61   (interactive "P")
  62   (or (call-interactively #'org-babel-open-src-block-result) ad-do-it))
  63
  64 (defun org-babel-load-in-session-maybe ()
  65   "Detect if this is context for a org-babel src-block and if so
  66 then run `org-babel-load-in-session'."
  67   (interactive)
  68   (let ((info (org-babel-get-src-block-info)))
  69     (if info (progn (org-babel-load-in-session current-prefix-arg info) t) nil)))
  70
  71 (add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
  72
  73 (defun org-babel-pop-to-session-maybe ()
  74   "Detect if this is context for a org-babel src-block and if so
  75 then run `org-babel-pop-to-session'."
  76   (interactive)
  77   (let ((info (org-babel-get-src-block-info)))
  78     (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
  79
  80 (add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
  81
  82 (defvar org-babel-default-header-args
  83   '((:session . "none") (:results . "replace") (:exports . "code"))
  84   "Default arguments to use when evaluating a source block.")
  85
  86 (defvar org-babel-default-inline-header-args
  87   '((:session . "none") (:results . "silent") (:exports . "results"))
  88   "Default arguments to use when evaluating an inline source block.")
  89
  90 (defvar org-babel-src-block-regexp nil
  91   "Regexp used to test when inside of a org-babel src-block")
  92
  93 (defvar org-babel-inline-src-block-regexp nil
  94   "Regexp used to test when on an inline org-babel src-block")
  95
  96 (defvar org-babel-min-lines-for-block-output 10
  97   "If number of lines of output is equal to or exceeds this
  98   value, the output is placed in a
  99   #+begin_example...#+end_example block. Otherwise the output is
 100   marked as literal by inserting colons at the starts of the
 101   lines. This variable only takes effect if the :results output
 102   option is in effect.")
 103
 104 (defun org-babel-named-src-block-regexp-for-name (name)
 105   "Regexp used to match named src block."
 106   (concat "#\\+srcname:[ \t]*" (regexp-quote name) "[ \t\n]*"
 107           (substring org-babel-src-block-regexp 1)))
 108
 109 (defun org-babel-set-interpreters (var value)
 110   (set-default var value)
 111   (setq org-babel-src-block-regexp
 112         (concat "^[ \t]*#\\+begin_src[ \t]+\\("       ;; (1)   lang
 113                 (mapconcat 'regexp-quote value "\\|")
 114                 "\\)[ \t]*"
 115                 "\\([^:\n]*\\)"                       ;; (2)   switches
 116                 "\\([^\n]*\\)\n"                      ;; (3)   header arguments
 117                 "\\([^\000]+?\\)#\\+end_src"))        ;; (4)   body
 118   (setq org-babel-inline-src-block-regexp
 119         (concat "[ \f\t\n\r\v]\\(src_"                ;; (1)   replacement target
 120                 "\\("                                 ;; (2)   lang
 121                 (mapconcat 'regexp-quote value "\\|")
 122                 "\\)"
 123                 "\\(\\|\\[\\(.*\\)\\]\\)"             ;; (3,4) (unused, headers)
 124                 "{\\([^\f\n\r\v]+\\)}"                ;; (5)   body
 125                 "\\)")))
 126
 127 (defun org-babel-add-interpreter (interpreter)
 128   "Add INTERPRETER to `org-babel-interpreters' and update
 129 `org-babel-src-block-regexp' appropriately."
 130   (unless (member interpreter org-babel-interpreters)
 131     (setq org-babel-interpreters (cons interpreter org-babel-interpreters))
 132     (org-babel-set-interpreters 'org-babel-interpreters org-babel-interpreters)))
 133
 134 (defcustom org-babel-interpreters '()
 135   "Interpreters allows for evaluation tags.
 136 This is a list of program names (as strings) that can evaluate code and
 137 insert the output into an Org-mode buffer.  Valid choices are
 138
 139 R          Evaluate R code
 140 emacs-lisp Evaluate Emacs Lisp code and display the result
 141 sh         Pass command to the shell and display the result
 142 perl       The perl interpreter
 143 python     The python interpreter
 144 ruby       The ruby interpreter
 145
 146 The source block regexp `org-babel-src-block-regexp' is updated
 147 when a new interpreter is added to this list through the
 148 customize interface.  To add interpreters to this variable from
 149 lisp code use the `org-babel-add-interpreter' function."
 150   :group 'org-babel
 151   :set 'org-babel-set-interpreters
 152   :type '(set :greedy t
 153               (const "R")
 154               (const "emacs-lisp")
 155               (const "sh")
 156               (const "perl")
 157               (const "python")
 158               (const "ruby")))
 159
 160 ;;; functions
 161 (defun org-babel-execute-src-block (&optional arg info params)
 162   "Execute the current source code block, and dump the results
 163 into the buffer immediately following the block.  Results are
 164 commented by `org-toggle-fixed-width-section'.  With optional
 165 prefix don't dump results into buffer but rather return the
 166 results in raw elisp (this is useful for automated execution of a
 167 source block).
 168
 169 Optionally supply a value for INFO in the form returned by
 170 `org-babel-get-src-block-info'.
 171
 172 Optionally supply a value for PARAMS which will be merged with
 173 the header arguments specified at the source code block."
 174   (interactive)
 175   ;; (message "supplied params=%S" params) ;; debugging
 176   (let* ((info (or info (org-babel-get-src-block-info)))
 177          (lang (first info))
 178          (params (org-babel-merge-params (third info) params))
 179          (body (if (assoc :noweb params)
 180                    (org-babel-expand-noweb-references info) (second info)))
 181          (processed-params (org-babel-process-params params))
 182          (result-params (third processed-params))
 183          (result-type (fourth processed-params))
 184          (cmd (intern (concat "org-babel-execute:" lang)))
 185          result)
 186     ;; (message "params=%S" params) ;; debugging statement
 187     ;; (message "vars=%S" (second processed-params)) ;; debugging statement
 188     (unless (member lang org-babel-interpreters)
 189       (error "Language is not in `org-babel-interpreters': %s" lang))
 190     (when arg (setq result-params (cons "silent" result-params)))
 191     (setq result (multiple-value-bind (session vars result-params result-type) processed-params
 192                    (funcall cmd body params)))
 193     (if (eq result-type 'value)
 194         (setq result (org-babel-process-value-result result result-params)))
 195     (org-babel-insert-result result result-params)
 196     result))
 197
 198 (defun org-babel-load-in-session (&optional arg info)
 199   "Load the body of the current source-code block.  Evaluate the
 200 header arguments for the source block before entering the
 201 session.  After loading the body this pops open the session."
 202   (interactive)
 203   (let* ((info (or info (org-babel-get-src-block-info)))
 204          (lang (first info))
 205          (body (second info))
 206          (params (third info))
 207          (session (cdr (assoc :session params))))
 208     (unless (member lang org-babel-interpreters)
 209       (error "Language is not in `org-babel-interpreters': %s" lang))
 210     ;; if called with a prefix argument, then process header arguments
 211     (pop-to-buffer (funcall (intern (concat "org-babel-load-session:" lang)) session body params))
 212     (move-end-of-line 1)))
 213
 214 (defun org-babel-pop-to-session (&optional arg info)
 215   "Pop to the session of the current source-code block.  If
 216 called with a prefix argument then evaluate the header arguments
 217 for the source block before entering the session.  Copy the body
 218 of the source block to the kill ring."
 219   (interactive)
 220   (let* ((info (or info (org-babel-get-src-block-info)))
 221          (lang (first info))
 222          (body (second info))
 223          (params (third info))
 224          (session (cdr (assoc :session params))))
 225     (unless (member lang org-babel-interpreters)
 226       (error "Language is not in `org-babel-interpreters': %s" lang))
 227     ;; copy body to the kill ring
 228     (with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max)))
 229     ;; if called with a prefix argument, then process header arguments
 230     (if arg (funcall (intern (concat "org-babel-prep-session:" lang)) session params))
 231     ;; just to the session using pop-to-buffer
 232     (pop-to-buffer (funcall (intern (format "org-babel-%s-initiate-session" lang)) session))
 233     (move-end-of-line 1)))
 234
 235 (defun org-babel-open-src-block-result (&optional re-run)
 236   "If `point' is on a src block then open the results of the
 237 source code block, otherwise return nil.  With optional prefix
 238 argument RE-RUN the source-code block is evaluated even if
 239 results already exist."
 240   (interactive "P")
 241   (when (org-babel-get-src-block-info)
 242     (save-excursion
 243       ;; go to the results, if there aren't any then run the block
 244       (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
 245                      (progn (org-babel-execute-src-block)
 246                             (org-babel-where-is-src-block-result))))
 247       (move-end-of-line 1) (forward-char 1)
 248       ;; open the results
 249       (if (looking-at org-bracket-link-regexp)
 250           ;; file results
 251           (org-open-at-point)
 252         (let ((results (org-babel-read-result)))
 253           (flet ((echo-res (result)
 254                            (if (stringp result) result (format "%S" result))))
 255             (pop-to-buffer (get-buffer-create "org-babel-results"))
 256             (delete-region (point-min) (point-max))
 257             (if (listp results)
 258                 ;; table result
 259                 (insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res)))
 260               ;; scalar result
 261               (insert (echo-res results))))))
 262       t)))
 263
 264 (defun org-babel-process-value-result (result result-params)
 265   "Process returned value for insertion in buffer.
 266
 267 Currently, this function forces to table output if :results
 268 table or :results vector has been supplied.
 269
 270   You can see below the various fragments of results-processing
 271 code that were present in the language-specific files. Out of
 272 those fragments, I've moved the org-babel-python-table-or-results
 273 and org-babel-import-elisp-from-file functionality into the
 274 org-babel-*-evaluate functions. I think those should only be used
 275 in the :results value case, as in the 'output case we are not
 276 concerned with creating elisp versions of results. "
 277
 278   (if (and (or (member "vector" result-params)
 279                (member "table" result-params))
 280            (not (listp result)))
 281       (list (list result))
 282     result))
 283
 284 (defun org-babel-execute-buffer (&optional arg)
 285   "Replace EVAL snippets in the entire buffer."
 286   (interactive "P")
 287   (save-excursion
 288     (goto-char (point-min))
 289     (while (re-search-forward org-babel-src-block-regexp nil t)
 290       (goto-char (match-beginning 0))
 291       (org-babel-execute-src-block arg)
 292       (goto-char (match-end 0)))))
 293
 294 (defun org-babel-execute-subtree (&optional arg)
 295   "Replace EVAL snippets in the entire subtree."
 296   (interactive "P")
 297   (save-excursion
 298     (org-narrow-to-subtree)
 299     (org-babel-execute-buffer)
 300     (widen)))
 301
 302 (defun org-babel-get-src-block-info (&optional header-vars-only)
 303   "Get information of the current source block.
 304 Returns a list
 305  (language body header-arguments-alist switches name function-args).
 306 Unless HEADER-VARS-ONLY is non-nil, any variable
 307 references provided in 'function call style' (i.e. in a
 308 parenthesised argument list following the src block name) are
 309 added to the header-arguments-alist."
 310   (let ((case-fold-search t) head info args)
 311     (if (setq head (org-babel-where-is-src-block-head))
 312         (save-excursion
 313           (goto-char head)
 314           (setq info (org-babel-parse-src-block-match))
 315           (forward-line -1)
 316           (when (looking-at "#\\+srcname:[ \t]*\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
 317             (setq info (append info (list (org-babel-clean-text-properties (match-string 1)))))
 318             ;; Note that e.g. "name()" and "name( )" result in ((:var . "")).
 319             ;; We maintain that behaviour, and the resulting non-nil sixth
 320             ;; element is relied upon in org-babel-exp-code to detect a functional-style
 321             ;; block in those cases. However, "name" without any
 322             ;; parentheses would result in the same thing, so we
 323             ;; explicitly avoid that.
 324             (if (setq args (match-string 3))
 325                 (setq info (append info (list (mapcar (lambda (ref) (cons :var ref))
 326                                                       (org-babel-ref-split-args args))))))
 327             (unless header-vars-only
 328               (setf (third info)
 329                     (org-babel-merge-params (sixth info) (third info)))))
 330           info)
 331       (if (save-excursion ;; inline source block
 332             (re-search-backward "[ \f\t\n\r\v]" nil t)
 333             (looking-at org-babel-inline-src-block-regexp))
 334           (org-babel-parse-inline-src-block-match)
 335         nil)))) ;; indicate that no source block was found
 336
 337 (defmacro org-babel-map-source-blocks (file &rest body)
 338   "Evaluate BODY forms on each source-block in FILE."
 339   (declare (indent 1))
 340   `(let ((visited-p (get-buffer (file-name-nondirectory ,file))))
 341      (save-window-excursion
 342        (find-file ,file) (goto-char (point-min))
 343        (while (re-search-forward org-babel-src-block-regexp nil t)
 344          (goto-char (match-beginning 0))
 345          (save-match-data ,@body)
 346          (goto-char (match-end 0))))
 347      (unless visited-p (kill-buffer (file-name-nondirectory file)))))
 348
 349 (defun org-babel-params-from-properties ()
 350   "Return an association list of any source block params which
 351 may be specified in the properties of the current outline entry."
 352   (save-match-data
 353     (delq nil
 354           (mapcar
 355            (lambda (header-arg)
 356              (let ((val (or (org-entry-get (point) header-arg 'selective)
 357                             (cdr (assoc header-arg org-file-properties)))))
 358                (when val
 359                  ;; (message "param-from-property %s=%s" header-arg val) ;; debugging statement
 360                  (cons (intern (concat ":" header-arg)) val))))
 361            '("exports" "results" "session" "tangle" "var")))))
 362
 363 (defun org-babel-parse-src-block-match ()
 364   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
 365          (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
 366          (switches (match-string 2))
 367          (body (org-babel-clean-text-properties (match-string 4)))
 368          (preserve-indentation (or org-src-preserve-indentation
 369                                    (string-match "-i\\>" switches))))
 370     (list lang
 371           ;; get src block body removing properties, protective commas, and indentation
 372           (with-temp-buffer
 373             (save-match-data
 374               (insert (org-babel-strip-protective-commas body))
 375               (unless preserve-indentation (org-do-remove-indentation))
 376               (buffer-string)))
 377           (org-babel-merge-params
 378            org-babel-default-header-args
 379            (org-babel-params-from-properties)
 380            (if (boundp lang-headers) (eval lang-headers) nil)
 381            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) ""))))
 382           switches)))
 383
 384 (defun org-babel-parse-inline-src-block-match ()
 385   (let* ((lang (org-babel-clean-text-properties (match-string 2)))
 386          (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
 387     (list lang
 388           (org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 5)))
 389           (org-babel-merge-params
 390            org-babel-default-inline-header-args
 391            (org-babel-params-from-properties)
 392            (if (boundp lang-headers) (eval lang-headers) nil)
 393            (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 4) "")))))))
 394
 395 (defun org-babel-parse-header-arguments (arg-string)
 396   "Parse a string of header arguments returning an alist."
 397   (if (> (length arg-string) 0)
 398       (delq nil
 399             (mapcar
 400              (lambda (arg)
 401                (if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg)
 402                    (cons (intern (concat ":" (match-string 1 arg)))
 403                          (org-babel-chomp (match-string 2 arg)))
 404                  (cons (intern (concat ":" arg)) nil)))
 405              (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
 406
 407 (defun org-babel-process-params (params)
 408   "Parse params and resolve references.
 409
 410 Return a list (session vars result-params result-type). These are
 411 made available to the org-babel-execute:LANG functions via
 412 multiple-value-bind."
 413   (let* ((session (cdr (assoc :session params)))
 414          (vars (org-babel-ref-variables params))
 415          (result-params (split-string (or (cdr (assoc :results params)) "")))
 416          (result-type (cond ((member "output" result-params) 'output)
 417                             ((member "value" result-params) 'value)
 418                             (t 'value))))
 419     (list session vars result-params result-type)))
 420
 421 (defun org-babel-where-is-src-block-head ()
 422   "Return the point at the beginning of the current source
 423 block.  Specifically at the beginning of the #+BEGIN_SRC line.
 424 If the point is not on a source block then return nil."
 425   (let ((initial (point)) top bottom)
 426     (or
 427      (save-excursion ;; on a #+srcname: line
 428        (beginning-of-line 1)
 429        (and (looking-at "#\\+srcname") (forward-line 1)
 430             (looking-at org-babel-src-block-regexp)
 431             (point)))
 432      (save-excursion ;; on a #+begin_src line
 433        (beginning-of-line 1)
 434        (and (looking-at org-babel-src-block-regexp)
 435             (point)))
 436      (save-excursion ;; inside a src block
 437        (and
 438         (re-search-backward "#\\+begin_src" nil t) (setq top (point))
 439         (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
 440         (< top initial) (< initial bottom)
 441         (goto-char top) (move-beginning-of-line 1)
 442         (looking-at org-babel-src-block-regexp)
 443         (point))))))
 444
 445 (defun org-babel-goto-named-source-block (&optional name)
 446   "Go to a named source-code block."
 447   (interactive "ssource-block name: ")
 448   (let ((point (org-babel-find-named-block name)))
 449     (if point
 450         ;; taken from `org-open-at-point'
 451         (progn (goto-char point) (org-show-context))
 452       (message "source-code block '%s' not found in this buffer" name))))
 453
 454 (defun org-babel-find-named-block (name)
 455   "Find a named source-code block.
 456 Return the location of the source block identified by
 457 #+srcname NAME, or nil if no such block exists. Set match data
 458 according to org-babel-named-src-block-regexp."
 459   (save-excursion
 460     (let ((case-fold-search t)
 461           (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
 462       (goto-char (point-min))
 463       (when (or (re-search-forward regexp nil t)
 464                 (re-search-backward regexp nil t))
 465         (match-beginning 0)))))
 466
 467 (defun org-babel-find-named-result (name)
 468   "Return the location of the result named NAME in the current
 469 buffer or nil if no such result exists."
 470   (save-excursion
 471     (goto-char (point-min))
 472     (when (re-search-forward ;; ellow end-of-buffer in following regexp?
 473            (concat "#\\+resname:[ \t]*" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
 474       (move-beginning-of-line 0) (point))))
 475
 476 (defun org-babel-where-is-src-block-result (&optional insert)
 477   "Return the point at the beginning of the result of the current
 478 source block.  Specifically at the beginning of the #+RESNAME:
 479 line.  If no result exists for this block then create a
 480 #+RESNAME: line following the source block."
 481   (save-excursion
 482     (let* ((on-lob-line (progn (beginning-of-line 1)
 483                                (looking-at org-babel-lob-one-liner-regexp)))
 484            (name (if on-lob-line (first (org-babel-lob-get-info))
 485                    (fifth (org-babel-get-src-block-info))))
 486            (head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
 487       (when head (goto-char head))
 488       (or (and name (org-babel-find-named-result name))
 489           (and (or on-lob-line (re-search-forward "#\\+end_src" nil t))
 490                (progn (move-end-of-line 1)
 491                       (if (eobp) (insert "\n") (forward-char 1))
 492                       (setq end (point))
 493                       (or (and (not name)
 494                                (progn ;; either the unnamed #+resname: line already exists
 495                                  (re-search-forward "[^ \f\t\n\r\v]" nil t)
 496                                  (move-beginning-of-line 1) (looking-at "#\\+resname:\n")))
 497                           ;; or (with optional insert) we need to back up and make one ourselves
 498                           (when insert
 499                             (goto-char end) (open-line 2) (forward-char 1)
 500                             (insert (concat "#+resname:" (if name (concat " " name)) "\n"))
 501                             (move-beginning-of-line 0) t)))
 502                (point))))))
 503
 504 (defun org-babel-read-result ()
 505   "Read the result at `point' into emacs-lisp."
 506   (let ((case-fold-search t) result-string)
 507     (cond
 508      ((org-at-table-p) (org-babel-read-table))
 509      ((looking-at ": ")
 510       (setq result-string
 511             (org-babel-trim
 512              (mapconcat (lambda (line) (if (and (> (length line) 1)
 513                                                 (string= ": " (substring line 0 2)))
 514                                            (substring line 2)
 515                                          line))
 516                         (split-string
 517                          (buffer-substring (point) (org-babel-result-end)) "[\r\n]+")
 518                         "\n")))
 519       (or (org-babel-number-p result-string) result-string))
 520      ((looking-at "^#\\+RESNAME:")
 521       (save-excursion (forward-line 1) (org-babel-read-result))))))
 522
 523 (defun org-babel-read-table ()
 524   "Read the table at `point' into emacs-lisp."
 525   (mapcar (lambda (row)
 526             (if (and (symbolp row) (equal row 'hline)) row
 527               (mapcar #'org-babel-read row)))
 528           (org-table-to-lisp)))
 529
 530 (defun org-babel-insert-result (result &optional insert)
 531   "Insert RESULT into the current buffer after the end of the
 532 current source block.  With optional argument INSERT controls
 533 insertion of results in the org-mode file.  INSERT can take the
 534 following values...
 535
 536 replace - (default option) insert results after the source block
 537           replacing any previously inserted results
 538
 539 silent -- no results are inserted
 540
 541 file ---- the results are interpreted as a file path, and are
 542           inserted into the buffer using the Org-mode file syntax
 543
 544 raw ----- results are added directly to the org-mode file.  This
 545           is a good option if you code block will output org-mode
 546           formatted text.
 547
 548 org ----- this is the same as the 'raw' option
 549
 550 html ---- results are added inside of a #+BEGIN_HTML block.  This
 551           is a good option if you code block will output html
 552           formatted text.
 553
 554 latex --- results are added inside of a #+BEGIN_LATEX block.
 555           This is a good option if you code block will output
 556           latex formatted text.
 557
 558 code ---- the results are extracted in the syntax of the source
 559           code of the language being evaluated and are added
 560           inside of a #+BEGIN_SRC block with the source-code
 561           language set appropriately."
 562   (if (stringp result)
 563       (progn
 564         (setq result (org-babel-clean-text-properties result))
 565         (if (member "file" insert) (setq result (org-babel-result-to-file result))))
 566     (unless (listp result) (setq result (format "%S" result))))
 567   (if (and insert (member "replace" insert) (not (member "silent" insert)))
 568       (org-babel-remove-result))
 569   (if (= (length result) 0)
 570       (if (member "value" result-params)
 571           (message "No result returned by source block")
 572         (message "Source block produced no output"))
 573     (if (and insert (member "silent" insert))
 574         (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
 575       (when (and (stringp result) ;; ensure results end in a newline
 576                  (not (or (string-equal (substring result -1) "\n")
 577                           (string-equal (substring result -1) "\r"))))
 578         (setq result (concat result "\n")))
 579       (save-excursion
 580         (let ((existing-result (org-babel-where-is-src-block-result t)))
 581           (when existing-result (goto-char existing-result) (forward-line 1)))
 582         (cond
 583          ;; assume the result is a table if it's not a string
 584          ((not (stringp result))
 585           (insert (concat (orgtbl-to-orgtbl
 586                            (if (and (listp (car result)) (listp (cdr (car result))))
 587                                result (list result))
 588                            '(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
 589           (forward-line -1) (org-cycle))
 590          ((member "file" insert)
 591           (insert result))
 592          ((member "html" insert)
 593           (insert (format "#+BEGIN_HTML\n%s#+END_HTML\n" result)))
 594          ((member "latex" insert)
 595           (insert (format "#+BEGIN_LaTeX\n%s#+END_LaTeX\n" result)))
 596          ((member "code" insert)
 597           (insert (format "#+BEGIN_SRC %s\n%s#+END_SRC\n" lang result)))
 598          ((or (member "raw" insert) (member "org" insert))
 599           (save-excursion (insert result)) (if (org-at-table-p) (org-cycle)))
 600          (t
 601           (org-babel-examplize-region (point) (progn (insert result) (point))))))
 602       (message "finished"))))
 603
 604 (defun org-babel-result-to-org-string (result)
 605   "Return RESULT as a string in org-mode format.  This function
 606 relies on `org-babel-insert-result'."
 607   (with-temp-buffer (org-babel-insert-result result) (buffer-string)))
 608
 609 (defun org-babel-remove-result ()
 610   "Remove the result of the current source block."
 611   (interactive)
 612   (save-excursion
 613     (goto-char (org-babel-where-is-src-block-result t)) (forward-line 1)
 614     (delete-region (point) (org-babel-result-end))))
 615
 616 (defun org-babel-result-end ()
 617   "Return the point at the end of the current set of results"
 618   (save-excursion
 619     (if (org-at-table-p)
 620         (progn (goto-char (org-table-end)) (point))
 621       (let ((case-fold-search t))
 622         (cond
 623          ((looking-at "#\\+begin_latex")
 624           (search-forward "#+end_latex" nil t)
 625           (forward-line 1))
 626          ((looking-at "#\\+begin_html")
 627           (search-forward "#+end_html" nil t)
 628           (forward-line 1))
 629          ((looking-at "#\\+begin_example")
 630           (search-forward "#+end_example" nil t)
 631           (forward-line 1))
 632          ((looking-at "#\\+begin_src")
 633           (search-forward "#+end_src" nil t)
 634           (forward-line 1))
 635          (t (progn (while (looking-at "\\(: \\|\\[\\[\\)")
 636                      (forward-line 1))))))
 637       (point))))
 638
 639 (defun org-babel-result-to-file (result)
 640   "Return an `org-mode' link with the path being the value or
 641 RESULT, and the display being the `file-name-nondirectory' if
 642 non-nil."
 643   (concat "[[file:" result "]]"))
 644
 645 (defun org-babel-examplize-region (beg end)
 646   "Comment out region using the ': ' org example quote."
 647   (interactive "*r")
 648   (let ((size (abs (- (line-number-at-pos end)
 649                       (line-number-at-pos beg)))))
 650     (save-excursion
 651       (cond ((= size 0)
 652              (error "This should be impossible: a newline was appended to result if missing")
 653              (let ((result (buffer-substring beg end)))
 654                (delete-region beg end)
 655                (insert (concat ": " result))))
 656             ((< size org-babel-min-lines-for-block-output)
 657              (goto-char beg)
 658              (dotimes (n size)
 659                (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
 660             (t
 661              (goto-char beg)
 662              (insert "#+begin_example\n")
 663              (forward-char (- end beg))
 664              (insert "#+end_example\n"))))))
 665
 666 (defun org-babel-merge-params (&rest plists)
 667   "Combine all parameter association lists in PLISTS.  Later
 668 elements of PLISTS override the values of previous element.  This
 669 takes into account some special considerations for certain
 670 parameters when merging lists."
 671   (let ((results-exclusive-groups
 672          '(("file" "vector" "table" "scalar" "raw" "org" "html" "latex" "code" "pp")
 673            ("replace" "silent")
 674            ("output" "value")))
 675         (exports-exclusive-groups
 676          '(("code" "results" "both" "none")))
 677         params results exports tangle vars var ref)
 678     (flet ((e-merge (exclusive-groups &rest result-params)
 679                     ;; maintain exclusivity of mutually exclusive parameters
 680                     (let (output)
 681                       (mapc (lambda (new-params)
 682                               (mapc (lambda (new-param)
 683                                       (mapc (lambda (exclusive-group)
 684                                               (when (member new-param exclusive-group)
 685                                                 (mapcar (lambda (excluded-param)
 686                                                           (setq output (delete excluded-param output)))
 687                                                         exclusive-group)))
 688                                             exclusive-groups)
 689                                       (setq output (org-uniquify (cons new-param output))))
 690                                     new-params))
 691                             result-params)
 692                       output)))
 693       (mapc (lambda (plist)
 694               (mapc (lambda (pair)
 695                       (case (car pair)
 696                         (:var
 697                          ;; we want only one specification per variable
 698                          (when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair))
 699                            ;; TODO: When is this not true?
 700                            (setq var (intern (match-string 1 (cdr pair)))
 701                                  ref (match-string 2 (cdr pair))
 702                                  vars (cons (cons var ref) (assq-delete-all var vars)))))
 703                         (:results
 704                          (setq results
 705                                (e-merge results-exclusive-groups results (split-string (cdr pair)))))
 706                         (:file
 707                          (when (cdr pair)
 708                            (setq results (e-merge results-exclusive-groups results '("file")))
 709                            (unless (or (member "both" exports) (member "none" exports))
 710                              (setq exports (e-merge exports-exclusive-groups exports '("results"))))
 711                            (setq params (cons pair (assq-delete-all (car pair) params)))))
 712                         (:exports
 713                          (setq exports (e-merge exports-exclusive-groups
 714                                                 exports (split-string (cdr pair)))))
 715                         (:tangle
 716                          (setq tangle (e-merge '(("yes" "no"))
 717                                                tangle (split-string (cdr pair)))))
 718                         (t ;; replace: this covers e.g. :session
 719                          (setq params (cons pair (assq-delete-all (car pair) params))))))
 720                     plist))
 721             plists))
 722     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
 723     (while vars (setq params (cons (cons :var (pop vars)) params)))
 724     (cons (cons :tangle (mapconcat 'identity tangle " "))
 725           (cons (cons :exports (mapconcat 'identity exports " "))
 726                 (cons (cons :results (mapconcat 'identity results " "))
 727                       params)))))
 728
 729 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
 730   "This function expands Noweb style references in the body of
 731 the current source-code block.  For example the following
 732 reference would be replaced with the body of the source-code
 733 block named 'example-block' (assuming the '#' character starts a
 734 comment) .
 735
 736 # <<example-block>>
 737
 738 This function must be called from inside of the buffer containing
 739 the source-code block which holds BODY.
 740
 741 In addition the following syntax can be used to insert the
 742 results of evaluating the source-code block named 'example-block'.
 743
 744 # <<example-block()>>
 745
 746 Any optional arguments can be passed to example-block by placing
 747 the arguments inside the parenthesis following the convention
 748 defined by `org-babel-lob'.  For example
 749
 750 # <<example-block(a=9)>>
 751
 752 would set the value of argument \"a\" equal to \"9\".  Note that
 753 these arguments are not evaluated in the current source-code block but are passed literally to the \"example-block\"."
 754   (let* ((parent-buffer (or parent-buffer (current-buffer)))
 755          (info (or info (org-babel-get-src-block-info)))
 756          (lang (first info))
 757          (body (second info))
 758          (new-body "") index source-name evaluate)
 759     (flet ((nb-add (text)
 760                    (setq new-body (concat new-body text))))
 761       (with-temp-buffer
 762         (insert body) (goto-char (point-min))
 763         (funcall (intern (concat (or (and (cdr (assoc lang org-src-lang-modes))
 764                                           (symbol-name
 765                                            (cdr (assoc lang org-src-lang-modes))))
 766                                      lang) "-mode")))
 767         (setq index (point))
 768         (while (and (re-search-forward "<<\\(.+?\\)>>" nil t))
 769           (save-match-data (setf source-name (match-string 1)))
 770           (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
 771           ;; add interval to new-body (removing noweb reference)
 772           (goto-char (match-beginning 0))
 773           (nb-add (buffer-substring index (point)))
 774           (goto-char (match-end 0))
 775           (setq index (point))
 776           (nb-add (save-excursion
 777                     (set-buffer parent-buffer)
 778                     (if evaluate
 779                         (let ((raw (org-babel-ref-resolve-reference
 780                                     source-name nil)))
 781                           (if (stringp raw) raw (format "%S" raw)))
 782                       (let ((point (org-babel-find-named-block source-name)))
 783                         (if point
 784                             (save-excursion
 785                               (goto-char point)
 786                               (org-babel-trim (org-babel-expand-noweb-references
 787                                (org-babel-get-src-block-info))))
 788                           ""))))))
 789         (nb-add (buffer-substring index (point-max)))))
 790     new-body))
 791
 792 (defun org-babel-clean-text-properties (text)
 793   "Strip all properties from text return."
 794   (set-text-properties 0 (length text) nil text) text)
 795
 796 (defun org-babel-strip-protective-commas (body)
 797   "Strip protective commas from bodies of source blocks."
 798   (replace-regexp-in-string "^,#" "#" body))
 799
 800 (defun org-babel-read (cell)
 801   "Convert the string value of CELL to a number if appropriate.
 802 Otherwise if cell looks like lisp (meaning it starts with a
 803 \"(\" or a \"'\") then read it as lisp, otherwise return it
 804 unmodified as a string.
 805
 806 This is taken almost directly from `org-read-prop'."
 807   (if (and (stringp cell) (not (equal cell "")))
 808       (or (org-babel-number-p cell)
 809           (if (or (equal "(" (substring cell 0 1))
 810                   (equal "'" (substring cell 0 1)))
 811               (read cell)
 812             (progn (set-text-properties 0 (length cell) nil cell) cell)))
 813     cell))
 814
 815 (defun org-babel-number-p (string)
 816   "Return t if STRING represents a number"
 817   (if (and (string-match "^-?[[:digit:]]*\\.?[[:digit:]]*$" string)
 818            (= (match-end 0) (length string)))
 819       (string-to-number string)))
 820
 821 (defun org-babel-import-elisp-from-file (file-name)
 822   "Read the results located at FILE-NAME into an elisp table.  If
 823 the table is trivial, then return it as a scalar."
 824   (let (result)
 825     (with-temp-buffer
 826       (condition-case nil
 827           (progn
 828             (org-table-import file-name nil)
 829             (delete-file file-name)
 830             (setq result (mapcar (lambda (row)
 831                                    (mapcar #'org-babel-string-read row))
 832                                  (org-table-to-lisp))))
 833         (error nil)))
 834     (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
 835         (if (consp (car result))
 836             (if (null (cdr (car result)))
 837                 (caar result)
 838               result)
 839           (car result))
 840       result)))
 841
 842 (defun org-babel-string-read (cell)
 843   "Strip nested \"s from around strings in exported R values."
 844   (org-babel-read (or (and (stringp cell)
 845                            (string-match "\\\"\\(.+\\)\\\"" cell)
 846                            (match-string 1 cell))
 847                       cell)))
 848
 849 (defun org-babel-reverse-string (string)
 850   (apply 'string (reverse (string-to-list string))))
 851
 852 (defun org-babel-chomp (string &optional regexp)
 853   "Remove any trailing space or carriage returns characters from
 854 STRING.  Default regexp used is \"[ \f\t\n\r\v]\" but can be
 855 overwritten by specifying a regexp as a second argument."
 856   (let ((regexp (or regexp "[ \f\t\n\r\v]")))
 857     (while (and (> (length string) 0) (string-match regexp (substring string -1)))
 858       (setq string (substring string 0 -1)))
 859     string))
 860
 861 (defun org-babel-trim (string &optional regexp)
 862   "Like `org-babel-chomp' only it runs on both the front and back of the string"
 863   (org-babel-chomp (org-babel-reverse-string
 864                     (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
 865
 866 (provide 'org-babel)
 867 ;;; org-babel.el ends here