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