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