contrib/babel/lisp/org-babel-exp.el

   1 ;;; org-babel-exp.el --- Exportation of org-babel source blocks
   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 ;; for more information see the comments in org-babel.el
  30
  31 ;;; Code:
  32 (require 'org-babel)
  33 (require 'org-exp-blocks)
  34 (org-export-blocks-add-block '(src org-babel-exp-src-blocks nil))
  35 (add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks))
  36 (add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners))
  37 (add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup)
  38
  39 (defvar org-babel-function-def-export-keyword "function"
  40   "When exporting a source block function, this keyword will
  41 appear in the exported version in the place of source name
  42 line. A source block is considered to be a source block function
  43 if the source name is present and is followed by a parenthesized
  44 argument list. The parentheses may be empty or contain
  45 whitespace. An example is the following which generates n random
  46 (uniform) numbers.
  47
  48 #+source: rand(n)
  49 #+begin_src R
  50   runif(n)
  51 #+end_src
  52 ")
  53
  54 (defvar org-babel-function-def-export-indent 4
  55   "When exporting a source block function, the block contents
  56 will be indented by this many characters. See
  57 `org-babel-function-def-export-name' for the definition of a
  58 source block function.")
  59
  60 (defvar obe-marker nil)
  61
  62 (defun org-babel-exp-src-blocks (body &rest headers)
  63   "Process src block for export.  Depending on the 'export'
  64 headers argument in replace the source code block with...
  65
  66 both ---- display the code and the results
  67
  68 code ---- the default, display the code inside the block but do
  69           not process
  70
  71 results - just like none only the block is run on export ensuring
  72           that it's results are present in the org-mode buffer
  73
  74 none ----- do not display either code or results upon export"
  75   (interactive)
  76   (message "org-babel-exp processing...")
  77   (when (member (first headers) org-babel-interpreters)
  78     (save-excursion
  79       (goto-char (match-beginning 0))
  80       (let* ((info (org-babel-get-src-block-info))
  81              (params (third info)))
  82         ;; expand noweb references in the original file
  83         (setf (second info)
  84               (if (and (cdr (assoc :noweb params))
  85                        (string= "yes" (cdr (assoc :noweb params))))
  86                   (org-babel-expand-noweb-references
  87                    info (get-file-buffer org-current-export-file))
  88                 (second info)))
  89         (org-babel-exp-do-export info 'block)))))
  90
  91 (defun org-babel-exp-inline-src-blocks (start end)
  92   "Process inline src blocks between START and END for export.
  93 See `org-babel-exp-src-blocks' for export options, currently the
  94 options and are taken from `org-babel-defualt-inline-header-args'."
  95   (interactive)
  96   (save-excursion
  97     (goto-char start)
  98     (while (and (< (point) end)
  99                 (re-search-forward org-babel-inline-src-block-regexp end t))
 100       (let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
 101              (params (third info))
 102              (replacement
 103               (save-match-data
 104                 (if (org-babel-in-example-or-verbatim)
 105                     (buffer-substring (match-beginning 0) (match-end 0))
 106                   ;; expand noweb references in the original file
 107                   (setf (second info)
 108                         (if (and (cdr (assoc :noweb params))
 109                                  (string= "yes" (cdr (assoc :noweb params))))
 110                             (org-babel-expand-noweb-references
 111                              info (get-file-buffer org-current-export-file))
 112                           (second info)))
 113                   (org-babel-exp-do-export info 'inline)))))
 114         (setq end (+ end (- (length replacement) (length (match-string 1)))))
 115         (replace-match replacement t t nil 1)))))
 116
 117 (defun org-exp-res/src-name-cleanup ()
 118   "Cleanup leftover #+results and #+srcname lines as part of the
 119 org export cycle.  This should only be called after all block
 120 processing has taken place."
 121   (interactive)
 122   (save-excursion
 123     (goto-char (point-min))
 124     (while (re-search-forward
 125             (concat
 126              "\\("org-babel-source-name-regexp"\\|"org-babel-result-regexp"\\)")
 127             nil t)
 128       (delete-region
 129        (progn (beginning-of-line) (point))
 130        (progn (end-of-line) (+ 1 (point)))))))
 131
 132 (defun org-babel-in-example-or-verbatim ()
 133   "Return true if the point is currently in an escaped portion of
 134 an org-mode buffer code which should be treated as normal
 135 org-mode text."
 136   (or (org-in-indented-comment-line)
 137       (save-excursion
 138         (save-match-data
 139           (goto-char (point-at-bol))
 140           (looking-at "[ \t]*:[ \t]")))
 141       (org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
 142
 143 (defun org-babel-exp-lob-one-liners (start end)
 144   "Process #+lob (Library of Babel) calls between START and END for export.
 145 See `org-babel-exp-src-blocks' for export options. Currently the
 146 options are taken from `org-babel-default-header-args'."
 147   (interactive)
 148   (let (replacement)
 149     (save-excursion
 150       (goto-char start)
 151       (while (and (< (point) end)
 152                   (re-search-forward org-babel-lob-one-liner-regexp nil t))
 153         (setq replacement
 154               (let ((lob-info (org-babel-lob-get-info)))
 155                 (save-match-data
 156                   (org-babel-exp-do-export
 157                    (list "emacs-lisp" "results"
 158                          (org-babel-merge-params
 159                           org-babel-default-header-args
 160                           (org-babel-parse-header-arguments
 161                            (org-babel-clean-text-properties
 162                             (concat ":var results="
 163                                     (mapconcat #'identity
 164                                                (butlast lob-info) " ")))))
 165                          (car (last lob-info)))
 166                    'lob))))
 167         (setq end (+ end (- (length replacement) (length (match-string 0)))))
 168         (replace-match replacement t t)))))
 169
 170 (defun org-babel-exp-do-export (info type)
 171   "Return a string containing the exported content of the current
 172 code block respecting the value of the :exports header argument."
 173   (flet ((silently () (let ((session (cdr (assoc :session (third info)))))
 174                         (when (and session
 175                                    (not (equal "none" session))
 176                                    (not (assoc :noeval (third info))))
 177                           (org-babel-exp-results info type 'silent))))
 178          (clean () (org-babel-remove-result info)))
 179     (case (intern (or (cdr (assoc :exports (third info))) "code"))
 180       ('none (silently) (clean) "")
 181       ('code (silently) (clean) (org-babel-exp-code info type))
 182       ('results (org-babel-exp-results info type))
 183       ('both (concat (org-babel-exp-code info type)
 184                      "\n\n"
 185                      (org-babel-exp-results info type))))))
 186
 187 (defun org-babel-exp-code (info type)
 188   "Return the code the current code block in a manner suitable
 189 for exportation by org-mode.  This function is called by
 190 `org-babel-exp-do-export'.  The code block will not be
 191 evaluated."
 192   (let ((lang (first info))
 193         (body (second info))
 194         (switches (fourth info))
 195         (name (fifth info))
 196         (args (mapcar
 197                #'cdr
 198                (remove-if-not (lambda (el) (eq :var (car el))) (third info)))))
 199     (case type
 200       ('inline (format "=%s=" body))
 201       ('block
 202           (let ((str
 203                  (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body
 204                          (if (and body (string-match "\n$" body))
 205                              "" "\n"))))
 206             (when name
 207               (add-text-properties
 208                0 (length str)
 209                (list 'org-caption
 210                      (format "%s(%s)"
 211                              name
 212                              (mapconcat #'identity args ", ")))
 213                str))
 214             str))
 215       ('lob
 216        (let ((call-line (and (string-match "results=" (car args))
 217                              (substring (car args) (match-end 0)))))
 218          (cond
 219           ((eq backend 'html)
 220            (format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n"
 221                    call-line))
 222           ((t (format ": %s\n" call-line)))))))))
 223
 224 (defun org-babel-exp-results (info type &optional silent)
 225   "Return the results of the current code block in a manner
 226 suitable for exportation by org-mode.  This function is called by
 227 `org-babel-exp-do-export'.  The code block will be evaluated.
 228 Optional argument SILENT can be used to inhibit insertion of
 229 results into the buffer."
 230   (let ((lang (first info))
 231         (body (second info))
 232         (params
 233          ;; lets ensure that we lookup references in the original file
 234          (mapcar
 235           (lambda (pair)
 236             (if (and org-current-export-file
 237                      (eq (car pair) :var)
 238                      (string-match org-babel-ref-split-regexp (cdr pair))
 239                      (null (org-babel-ref-literal (match-string 2 (cdr pair)))))
 240                 `(:var . ,(concat (match-string 1 (cdr pair))
 241                                   "=" org-current-export-file
 242                                   ":" (match-string 2 (cdr pair))))
 243               pair))
 244           (third info))))
 245     (case type
 246       ('inline
 247         (let ((raw (org-babel-execute-src-block
 248                     nil info '((:results . "silent"))))
 249               (result-params (split-string (cdr (assoc :results params)))))
 250           (unless silent
 251             (cond ;; respect the value of the :results header argument
 252              ((member "file" result-params)
 253               (org-babel-result-to-file raw))
 254              ((or (member "raw" result-params) (member "org" result-params))
 255               (format "%s" raw))
 256              ((member "code" result-params)
 257               (format "src_%s{%s}" lang raw))
 258              (t
 259               (if (stringp raw)
 260                   (if (= 0 (length raw)) "=(no results)="
 261                     (format "%s" raw))
 262                 (format "%S" raw)))))))
 263       ('block
 264           (org-babel-execute-src-block
 265            nil info (org-babel-merge-params
 266                      params `((:results . ,(if silent "silent" "replace")))))
 267         "")
 268       ('lob
 269        (save-excursion
 270          (re-search-backward org-babel-lob-one-liner-regexp nil t)
 271          (org-babel-execute-src-block
 272           nil info (org-babel-merge-params
 273                     params `((:results . ,(if silent "silent" "replace")))))
 274          "")))))
 275
 276 (provide 'org-babel-exp)
 277 ;;; org-babel-exp.el ends here