lisp/ob-exp.el

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