ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'babel'

This commit is contained in:
Eric Schulte 2009-09-13 21:14:01 -06:00
parent 0054bf1105 133aa88a06
commit 898f8e3bc8
23 changed files with 3241 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
contrib/babel/library-of-babel.org Normal file
View File

@ -0,0 +1,68 @@
#+title: The Library of Babel
#+SEQ_TODO: TODO PROPOSED | DONE DEFERRED REJECTED
#+OPTIONS: H:3 num:nil toc:2 \n:nil @:t ::t |:t ^:t -:t f:t *:t TeX:t LaTeX:t skip:nil d:(HIDE) tags:not-in-toc
#+STARTUP: odd hideblocks
* Introduction
The Library of Babel is an extensible collection of ready-made and
easily-shortcut-callable source-code blocks for handling common
tasks. Org-babel comes pre-populated with the source-code blocks
located in this file. It is possible to add source-code blocks from
any org-mode file to the library by calling =(org-babel-lob-ingest
"path/to/file.org")=.
* Plotting code
** R
Plot column 2 (y axis) against column 1 (x axis). Columns 3 and beyond, if present, are ignored.
#+srcname: R-plot(data=R-plot-example-data)
#+begin_src R :session *R*
plot(data)
#+end_src
#+tblname: R-plot-example-data
| 1 | 2 |
| 2 | 4 |
| 3 | 9 |
| 4 | 16 |
| 5 | 25 |
#+lob: R-plot(data=R-plot-example-data)
#+resname: R-plot(data=R-plot-example-data)
: nil
** Gnuplot
* Table/Matrix manipulation
Elegant lisp code for transposing a matrix.
#+tblname: transpose-example
| 1 | 2 | 3 |
| 4 | 5 | 6 |
#+srcname: transpose
#+begin_src emacs-lisp :var table=transpose-example
(apply #'mapcar* #'list table)
#+end_src
#+resname:
| 1 | 4 |
| 2 | 5 |
| 3 | 6 |
* Misc
#+srcname: python-identity(a=1)
#+begin_src python
a
#+end_src
#+srcname: python-add(a=1, b=2)
#+begin_src python
a + b
#+end_src

160
contrib/babel/lisp/langs/org-babel-R.el Normal file
View File

@ -0,0 +1,160 @@
;;; org-babel-R.el --- org-babel functions for R code evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, R, statistics
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating R code
;;; Code:
(require 'org-babel)
(org-babel-add-interpreter "R")
(add-to-list 'org-babel-tangle-langs '("R" "r"))
(defun org-babel-execute:R (body params)
"Execute a block of R code with org-babel. This function is
called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing R source code block...")
(save-window-excursion
(let ((full-body (concat
(mapconcat ;; define any variables
(lambda (pair)
(org-babel-R-assign-elisp (car pair) (cdr pair)))
vars "\n") "\n" body "\n"))
(session (org-babel-R-initiate-session session))
(column-names-p (cdr (assoc :colnames params))))
(org-babel-R-evaluate session full-body result-type column-names-p))))
(defun org-babel-prep-session:R (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-R-initiate-session session))
(vars (org-babel-ref-variables params)))
(mapc (lambda (pair) (org-babel-R-assign-elisp session (car pair) (cdr pair))) vars)))
;; helper functions
(defun org-babel-R-quote-tsv-field (s)
"Quote field S for export to R."
(if (stringp s)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
(format "%S" s)))
(defun org-babel-R-assign-elisp (name value)
"Read the elisp VALUE into a variable named NAME."
(if (listp value)
(let ((transition-file (make-temp-file "org-babel-R-import")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file
(insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
(insert "\n"))
(format "%s <- read.table(\"%s\", header=%s, sep=\"\\t\", as.is=TRUE)"
name transition-file (if (eq (second value) 'hline) "TRUE" "FALSE")))
(format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
(defun org-babel-R-initiate-session (session)
"If there is not a current R process then create one."
(unless (string= session "none")
(setq session (or session "*R*"))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
(R)
(rename-buffer (if (bufferp session) (buffer-name session)
(if (stringp session) session (buffer-name)))) (current-buffer)))))
(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
(defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n}
write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=%s, quote=FALSE)")
(defun org-babel-R-evaluate (buffer body result-type column-names-p)
"Pass BODY to the R process in BUFFER. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(if (not session)
;; external process evaluation
(let ((in-tmp-file (make-temp-file "R-in-functional-results"))
(out-tmp-file (make-temp-file "R-out-functional-results")))
(case result-type
(output
(with-temp-file in-tmp-file (insert body))
(shell-command-to-string (format "R --slave --no-save < '%s' > '%s'"
in-tmp-file out-tmp-file))
(with-temp-buffer (insert-file-contents out-tmp-file) (buffer-string)))
(value
(with-temp-file in-tmp-file
(insert (format org-babel-R-wrapper-method
body out-tmp-file (if column-names-p "TRUE" "FALSE"))))
(shell-command (format "R --no-save < '%s'" in-tmp-file))
(org-babel-R-process-value-result
(org-babel-import-elisp-from-file out-tmp-file) column-names-p))))
;; comint session evaluation
(org-babel-comint-in-buffer buffer
(let* ((tmp-file (make-temp-file "org-babel-R"))
(full-body
(case result-type
(value
(mapconcat #'org-babel-chomp (list body
(format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=%s, quote=FALSE)" tmp-file (if column-names-p "TRUE" "FALSE"))
org-babel-R-eoe-indicator) "\n"))
(output
(mapconcat #'org-babel-chomp (list body org-babel-R-eoe-indicator) "\n"))))
(raw (org-babel-comint-with-output buffer org-babel-R-eoe-output nil
(insert full-body) (inferior-ess-send-input)))
broke results)
(case result-type
(value (org-babel-R-process-value-result
(org-babel-import-elisp-from-file tmp-file) column-names-p))
(output
(flet ((extractor
(el)
(if (or broke
(and (string-match (regexp-quote org-babel-R-eoe-output) el)
(setq broke t)))
nil
(if (= (length el) 0)
nil
(if (string-match comint-prompt-regexp el)
(substring el (match-end 0))
el)))))
(mapconcat
#'identity
(delete nil (mapcar #'extractor (mapcar #'org-babel-chomp raw))) "\n"))))))))
(defun org-babel-R-process-value-result (result column-names-p)
"R-specific processing of return value prior to return to org-babel.
Currently, insert hline if column names in output have been requested."
(if column-names-p
(cons (car result) (cons 'hline (cdr result)))
result))
(provide 'org-babel-R)
;;; org-babel-R.el ends here

71
contrib/babel/lisp/langs/org-babel-asymptote.el Normal file
View File

@ -0,0 +1,71 @@
;;; org-babel-asymptote.el --- org-babel functions for asymptote evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating asymptote source code.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in asymptote
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments
;;
;; 4) there are no variables (at least for now)
;;; Code:
(require 'org-babel)
(org-babel-add-interpreter "asymptote")
(add-to-list 'org-babel-tangle-langs '("asymptote" "asymptote"))
(defvar org-babel-default-header-args:asymptote '((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a asymptote source block.")
(defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Asymptote source code block")
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(format (or (and (string-match ".+\\.\\(.+\\)" out-file)
(match-string 1 out-file))
"pdf"))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-asymptote")))
(with-temp-file in-file (insert body))
(message (concat "asy -globalwrite -f " format " -o " out-file " " cmdline " " in-file))
(shell-command (concat "asy -globalwrite -f " format " -o " out-file " " cmdline " " in-file))
out-file))
(defun org-babel-prep-session:asymptote (session params)
(error "Asymptote does not support sessions"))
(provide 'org-babel-asymptote)
;;; org-babel-asymptote.el ends here

50
contrib/babel/lisp/langs/org-babel-css.el Normal file
View File

@ -0,0 +1,50 @@
;;; org-babel-css.el --- org-babel functions for css evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Since CSS can't be executed, this file exists solely for tangling
;; CSS from org-mode files.
;;; Code:
(require 'org-babel)
(org-babel-add-interpreter "css")
(add-to-list 'org-babel-tangle-langs '("css" "css" nil t))
(defun org-babel-execute:css (body params)
"Execute a block of CSS code with org-babel. This function is
called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing CSS source code block")
body)
(defun org-babel-prep-session:css (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "CSS sessions are nonsensical"))
(provide 'org-babel-css)
;;; org-babel-css.el ends here

71
contrib/babel/lisp/langs/org-babel-ditaa.el Normal file
View File

@ -0,0 +1,71 @@
;;; org-babel-ditaa.el --- org-babel functions for ditaa evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating ditaa source code.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in ditaa
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments
;;
;; 4) there are no variables (at least for now)
;;; Code:
(require 'org-babel)
(org-babel-add-interpreter "ditaa")
(add-to-list 'org-babel-tangle-langs '("ditaa" "ditaa"))
(defvar org-babel-default-header-args:ditaa
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a ditaa source block.")
(defun org-babel-execute:ditaa (body params)
"Execute a block of Ditaa code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Ditaa source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-ditaa")))
(unless (file-exists-p org-ditaa-jar-path)
(error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
(with-temp-file in-file (insert body))
(message (concat "java -jar " org-ditaa-jar-path " " cmdline " " in-file " " out-file))
(shell-command (concat "java -jar " org-ditaa-jar-path " " cmdline " " in-file " " out-file))
out-file))
(defun org-babel-prep-session:ditaa (session params)
(error "Ditaa does not support sessions"))
(provide 'org-babel-ditaa)
;;; org-babel-ditaa.el ends here

70
contrib/babel/lisp/langs/org-babel-dot.el Normal file
View File

@ -0,0 +1,70 @@
;;; org-babel-dot.el --- org-babel functions for dot evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating dot source code.
;;
;; For information on dot see http://www.graphviz.org/
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in dot
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments
;;
;; 4) there are no variables (at least for now)
;;; Code:
(require 'org-babel)
(org-babel-add-interpreter "dot")
(add-to-list 'org-babel-tangle-langs '("dot" "dot"))
(defvar org-babel-default-header-args:dot '((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a dot source block.")
(defun org-babel-execute:dot (body params)
"Execute a block of Dot code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Dot source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-dot")))
(with-temp-file in-file (insert body))
(message (concat "dot " in-file " " cmdline " -o " out-file))
(shell-command (concat "dot " in-file " " cmdline " -o " out-file))
out-file))
(defun org-babel-prep-session:dot (session params)
(error "Dot does not support sessions"))
(provide 'org-babel-dot)
;;; org-babel-dot.el ends here

48
contrib/babel/lisp/langs/org-babel-emacs-lisp.el Normal file
View File

@ -0,0 +1,48 @@
;;; org-babel-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating emacs-lisp code
;;; Code:
(require 'org-babel)
(org-babel-add-interpreter "emacs-lisp")
(add-to-list 'org-babel-tangle-langs '("emacs-lisp" "el"))
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with org-babel. This
function is called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing emacs-lisp code block...")
(save-window-excursion
(let ((print-level nil) (print-length nil))
(eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) vars)
,(read (concat "(progn " body ")")))))))
(provide 'org-babel-emacs-lisp)
;;; org-babel-emacs-lisp.el ends here

184
contrib/babel/lisp/langs/org-babel-gnuplot.el Normal file
View File

@ -0,0 +1,184 @@
;;; org-babel-gnuplot.el --- org-babel functions for gnuplot evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating gnuplot source code.
;;
;; This differs from most standard languages in that
;;
;; 1) we are generally only going to return results of type "file"
;;
;; 2) we are adding the "file" and "cmdline" header arguments
;;; Requirements:
;; - gnuplot :: http://www.gnuplot.info/
;;
;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html
;;; Code:
(require 'org-babel)
(require 'gnuplot)
(org-babel-add-interpreter "gnuplot")
(add-to-list 'org-babel-tangle-langs '("gnuplot" "gnuplot"))
(defvar org-babel-default-header-args:gnuplot
'((:results . "file") (:exports . "results") (:session . nil))
"Default arguments to use when evaluating a gnuplot source block.")
(defvar org-babel-gnuplot-timestamp-fmt nil)
(defun org-babel-gnuplot-process-vars (params)
"Extract variables from PARAMS and process the variables
dumping all vectors into files returning an association list of
variable names and the value to be used in the gnuplot code."
(mapcar
(lambda (pair)
(cons
(car pair) ;; variable name
(if (listp (cdr pair)) ;; variable value
(org-babel-gnuplot-table-to-data
(cdr pair) (make-temp-file "org-babel-gnuplot") params)
(cdr pair))))
(org-babel-ref-variables params)))
(defun org-babel-execute:gnuplot (body params)
"Execute a block of Gnuplot code with org-babel. This function is
called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing Gnuplot source code block")
(let* ((vars (org-babel-gnuplot-process-vars params))
(out-file (cdr (assoc :file params)))
(term (or (cdr (assoc :term params))
(when out-file (file-name-extension out-file))))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-ditaa"))
(title (plist-get params :title))
(lines (plist-get params :line))
(sets (plist-get params :set))
(x-labels (plist-get params :xlabels))
(y-labels (plist-get params :ylabels))
(timefmt (plist-get params :timefmt))
(time-ind (or (plist-get params :timeind)
(when timefmt 1))))
(flet ((add-to-body (text)
(setq body (concat text "\n" body))))
;; append header argument settings to body
(when title (add-to-body (format "set title '%s'" title))) ;; title
(when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line
(when sets
(mapc (lambda (el) (add-to-body (format "set %s" el))) sets))
(when x-labels
(add-to-body
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels
(add-to-body
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind
(add-to-body "set xdata time")
(add-to-body (concat "set timefmt \""
(or timefmt
"%Y-%m-%d-%H:%M:%S") "\"")))
(when out-file (add-to-body (format "set output \"%s\"" out-file)))
(when term (add-to-body (format "set term %s" term)))
;; insert variables into code body: this should happen last
;; placing the variables at the *top* of the code in case their
;; values are used later
(add-to-body (mapconcat
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
vars "\n"))
;; evaluate the code body with gnuplot
(if (string= session "none")
(let ((script-file (make-temp-file "org-babel-gnuplot-script")))
(with-temp-file script-file
(insert (concat body "\n")))
(message "gnuplot \"%s\"" script-file)
(message (shell-command-to-string (format "gnuplot \"%s\"" script-file))))
(with-temp-buffer
(insert (concat body "\n"))
(gnuplot-mode)
(gnuplot-send-buffer-to-gnuplot)))
out-file)))
(defun org-babel-prep-session:gnuplot (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-gnuplot-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapconc
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
vars)))
(org-babel-comint-in-buffer session
(mapc (lambda (var-line)
(insert var-line) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1) (goto-char (point-max))) var-lines))))
(defun org-babel-gnuplot-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. The current
`gnuplot-mode' doesn't provide support for multiple sessions."
(unless (string= session "none")
(save-window-excursion (gnuplot-send-string-to-gnuplot "" "line")
(current-buffer))))
(defun org-babel-gnuplot-quote-timestamp-field (s)
"Convert field S from timestamp to Unix time and export to gnuplot."
(format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s)))
(defun org-babel-gnuplot-quote-tsv-field (s)
"Quote field S for export to gnuplot."
(unless (stringp s)
(setq s (format "%s" s)))
(if (string-match org-table-number-regexp s) s
(if (string-match org-ts-regexp3 s)
(org-babel-gnuplot-quote-timestamp-field s)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
(defun org-babel-gnuplot-table-to-data (table data-file params)
"Export TABLE to DATA-FILE in a format readable by gnuplot.
Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(with-temp-file data-file
(make-local-variable 'org-babel-gnuplot-timestamp-fmt)
(setq org-babel-gnuplot-timestamp-fmt (or
(plist-get params :timefmt)
"%Y-%m-%d-%H:%M:%S"))
(insert (orgtbl-to-generic
table
(org-combine-plists
'(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field)
params))))
data-file)
(provide 'org-babel-gnuplot)
;;; org-babel-gnuplot.el ends here

102
contrib/babel/lisp/langs/org-babel-haskell.el Normal file
View File

@ -0,0 +1,102 @@
;;; org-babel-haskell.el --- org-babel functions for haskell evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating haskell source code. This one will
;; be sort of tricky because haskell programs must be compiled before
;; they can be run, but haskell code can also be run through an
;; interactive interpreter.
;;
;; For now lets only allow evaluation using the haskell interpreter.
;;; Requirements:
;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;;
;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;;; Code:
(require 'org-babel)
(require 'haskell-mode)
(require 'inf-haskell)
(org-babel-add-interpreter "haskell")
(add-to-list 'org-babel-tangle-langs '("haskell" "hs"))
(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"")
(defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code with org-babel. This function
is called by `org-babel-execute-src-block' with the following
variables pre-set using `multiple-value-bind'.
(session vars result-params result-type)"
(message "executing haskell source code block")
(let* ((full-body (concat
(mapconcat
(lambda (pair) (format "let %s = %s;" (car pair) (cdr pair)))
vars "\n") "\n" body "\n"))
(session (org-babel-prep-session:haskell session params))
(raw (org-babel-comint-with-output session org-babel-haskell-eoe t
(insert (org-babel-trim full-body))
(comint-send-input nil t)
(insert org-babel-haskell-eoe)
(comint-send-input nil t)))
(results (mapcar
#'org-babel-haskell-read-string
(cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-babel-trim raw)))))))
(case result-type
(output (mapconcat #'identity (reverse (cdr results)) "\n"))
(value (org-babel-haskell-table-or-string (car results))))))
(defun org-babel-haskell-read-string (string)
"Strip \\\"s from around haskell string"
(if (string-match "\"\\([^\000]+\\)\"" string)
(match-string 1 string)
string))
(defun org-babel-prep-session:haskell (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(save-window-excursion (run-haskell) (current-buffer)))
(defun org-babel-haskell-table-or-string (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
"," " " (replace-regexp-in-string
"'" "\"" results)))))
results)))
(provide 'org-babel-haskell)
;;; org-babel-haskell.el ends here

121
contrib/babel/lisp/langs/org-babel-ocaml.el Normal file
View File

@ -0,0 +1,121 @@
;;; org-babel-ocaml.el --- org-babel functions for ocaml evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating ocaml source code. This one will
;; be sort of tricky because ocaml programs must be compiled before
;; they can be run, but ocaml code can also be run through an
;; interactive interpreter.
;;
;; For now lets only allow evaluation using the ocaml interpreter.
;;; Requirements:
;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/
;;; Code:
(require 'org-babel)
(require 'tuareg)
(org-babel-add-interpreter "ocaml")
(add-to-list 'org-babel-tangle-langs '("ocaml" "ml"))
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with org-babel. This function
is called by `org-babel-execute-src-block' with the following
variables pre-set using `multiple-value-bind'.
(session vars result-params result-type)"
(message "executing ocaml source code block")
(let* ((full-body (concat
(mapconcat
(lambda (pair) (format "let %s = %s;" (car pair) (cdr pair)))
vars "\n") "\n" body "\n"))
(session (org-babel-prep-session:ocaml session params))
(raw (org-babel-comint-with-output session org-babel-ocaml-eoe-output t
(insert (concat (org-babel-chomp full-body) " ;;"))
(comint-send-input nil t)
(insert org-babel-ocaml-eoe-indicator)
(comint-send-input nil t))))
(org-babel-ocaml-parse-output (org-babel-trim (car raw)))))
(defun org-babel-prep-session:ocaml (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let ((tuareg-interactive-buffer-name (if (and (not (string= session "none"))
(not (string= session "default"))
(stringp session))
session
tuareg-interactive-buffer-name)))
(save-window-excursion (tuareg-run-caml)
(get-buffer tuareg-interactive-buffer-name))))
(defun org-babel-ocaml-parse-output (output)
(let ((regexp "%s = \\(.+\\)$"))
(cond
((string-match (format regexp "string") output)
(org-babel-read (match-string 1 output)))
((or (string-match (format regexp "int") output)
(string-match (format regexp "float") output))
(string-to-number (match-string 1 output)))
((string-match (format regexp "list") output)
(org-babel-ocaml-read-list (match-string 1 output)))
((string-match (format regexp "array") output)
(org-babel-ocaml-read-array (match-string 1 output)))
(t (message "don't recognize type of %s" output) output))))
(defun org-babel-ocaml-read-list (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
"; " " " (replace-regexp-in-string
"'" "\"" results)))))
results)))
(defun org-babel-ocaml-read-array (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read
(replace-regexp-in-string
"\\[|" "(" (replace-regexp-in-string
"|\\]" ")" (replace-regexp-in-string
"; " " " (replace-regexp-in-string
"'" "\"" results)))))
results)))
(provide 'org-babel-ocaml)
;;; org-babel-ocaml.el ends here

180
contrib/babel/lisp/langs/org-babel-python.el Normal file
View File

@ -0,0 +1,180 @@
;;; org-babel-python.el --- org-babel functions for python evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating python source code.
;;; Code:
(require 'org-babel)
(require 'python)
(org-babel-add-interpreter "python")
(add-to-list 'org-babel-tangle-langs '("python" "py" "#!/usr/bin/env python"))
(defun org-babel-execute:python (body params)
"Execute a block of Python code with org-babel. This function is
called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing Python source code block")
(let ((full-body (concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
vars "\n") "\n" (org-babel-trim body) "\n")) ;; then the source block body
(session (org-babel-python-initiate-session session)))
(org-babel-python-evaluate session full-body result-type)))
(defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-python-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapcar ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
vars)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(move-end-of-line 1) (insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines))))
;; helper functions
(defun org-babel-python-var-to-python (var)
"Convert an elisp var into a string of python source code
specifying a var of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]")
(format "%S" var)))
(defun org-babel-python-table-or-string (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (string-match "^\\[.+\\]$" results)
(org-babel-read
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results)))))
results)))
(defvar org-babel-python-buffers '(:default . nil))
(defun org-babel-python-session-buffer (session)
(cdr (assoc session org-babel-python-buffers)))
(defun org-babel-python-initiate-session-by-key (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(save-window-excursion
(let* ((session (if session (intern session) :default))
(python-buffer (org-babel-python-session-buffer session)))
(run-python)
(setq org-babel-python-buffers (cons (cons session python-buffer)
(assq-delete-all session org-babel-python-buffers)))
session)))
(defun org-babel-python-initiate-session (&optional session)
(unless (string= session "none")
(org-babel-python-session-buffer (org-babel-python-initiate-session-by-key session))))
(defvar org-babel-python-last-value-eval "_"
"When evaluated by Python this returns the return value of the last statement.")
(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'"
"Used to indicate that evaluation is has completed.")
(defvar org-babel-python-wrapper-method
"
def main():
%s
open('%s', 'w').write( str(main()) )")
(defun org-babel-python-evaluate (buffer body &optional result-type)
"Pass BODY to the Python process in BUFFER. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(if (not session)
;; external process evaluation
(save-window-excursion
(case result-type
(output
(with-temp-buffer
(insert body)
;; (message "buffer=%s" (buffer-string)) ;; debugging
(shell-command-on-region (point-min) (point-max) "python" 'replace)
(buffer-string)))
(value
(let ((tmp-file (make-temp-file "python-functional-results")))
(with-temp-buffer
(insert
(format
org-babel-python-wrapper-method
(let ((lines (split-string
(org-remove-indentation (org-babel-trim body)) "[\r\n]")))
(concat
(mapconcat
(lambda (line) (format "\t%s" line))
(butlast lines) "\n")
(format "\n\treturn %s" (last lines))))
tmp-file))
;; (message "buffer=%s" (buffer-string)) ;; debugging
(shell-command-on-region (point-min) (point-max) "python"))
(org-babel-python-table-or-string
(with-temp-buffer (insert-file-contents tmp-file) (buffer-string)))))))
;; comint session evaluation
(org-babel-comint-in-buffer buffer
(let* ((raw (org-babel-comint-with-output buffer org-babel-python-eoe-indicator t
;; for some reason python is fussy, and likes enters after every input
(mapc (lambda (statement) (insert statement) (comint-send-input nil t))
(split-string (org-babel-trim full-body) "[\r\n]+"))
(comint-send-input nil t) (comint-send-input nil t)
(insert org-babel-python-last-value-eval)
(comint-send-input nil t)
(insert org-babel-python-eoe-indicator)
(comint-send-input nil t)))
(results (delete org-babel-python-eoe-indicator
(cdr (member org-babel-python-eoe-indicator
(reverse (mapcar #'org-babel-trim raw)))))))
(setq results (mapcar #'org-babel-python-read-string results))
(case result-type
(output (org-babel-trim (mapconcat #'identity (reverse (cdr results)) "\n")))
(value (org-babel-python-table-or-string (org-babel-trim (car results)))))))))
(defun org-babel-python-read-string (string)
"Strip 's from around ruby string"
(if (string-match "'\\([^\000]+\\)'" string)
(match-string 1 string)
string))
(provide 'org-babel-python)
;;; org-babel-python.el ends here

171
contrib/babel/lisp/langs/org-babel-ruby.el Normal file
View File

@ -0,0 +1,171 @@
;;; org-babel-ruby.el --- org-babel functions for ruby evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating ruby source code.
;;; Requirements:
;; - ruby and irb executables :: http://www.ruby-lang.org/
;;
;; - ruby-mode :: Can be installed through ELPA, or from
;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
;;
;; - inf-ruby mode :: Can be installed through ELPA, or from
;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
;;; Code:
(require 'org-babel)
(require 'inf-ruby)
(org-babel-add-interpreter "ruby")
(add-to-list 'org-babel-tangle-langs '("ruby" "rb" "#!/usr/bin/env ruby"))
(defun org-babel-execute:ruby (body params)
"Execute a block of Ruby code with org-babel. This function is
called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing Ruby source code block")
(let ((full-body (concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
vars "\n") "\n" body "\n")) ;; then the source block body
(session (org-babel-ruby-initiate-session session)))
(org-babel-ruby-evaluate session full-body result-type)))
(defun org-babel-prep-session:ruby (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
;; (message "params=%S" params) ;; debugging
(let* ((session (org-babel-ruby-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapcar ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
vars)))
;; (message "vars=%S" vars) ;; debugging
(org-babel-comint-in-buffer session
(sit-for .5) (goto-char (point-max))
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1) (goto-char (point-max))) var-lines))))
;; helper functions
(defun org-babel-ruby-var-to-ruby (var)
"Convert an elisp var into a string of ruby source code
specifying a var of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
(format "%S" var)))
(defun org-babel-ruby-table-or-string (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results)))))
results)))
(defun org-babel-ruby-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(unless (string= session "none")
(let ((session-buffer (save-window-excursion (run-ruby nil session) (current-buffer))))
(if (org-babel-comint-buffer-livep session-buffer)
session-buffer
(sit-for .5)
(org-babel-ruby-initiate-session session)))))
(defvar org-babel-ruby-last-value-eval "_"
"When evaluated by Ruby this returns the return value of the last statement.")
(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe"
"Used to indicate that evaluation is has completed.")
(defvar org-babel-ruby-wrapper-method
"
def main()
%s
end
results = main()
File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) }
")
(defun org-babel-ruby-evaluate (buffer body &optional result-type)
"Pass BODY to the Ruby process in BUFFER. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(if (not session)
;; external process evaluation
(save-window-excursion
(case result-type
(output
(with-temp-buffer
(insert body)
;; (message "buffer=%s" (buffer-string)) ;; debugging
(shell-command-on-region (point-min) (point-max) "ruby" 'replace)
(buffer-string)))
(value
(let ((tmp-file (make-temp-file "ruby-functional-results")))
(with-temp-buffer
(insert (format org-babel-ruby-wrapper-method body tmp-file))
;; (message "buffer=%s" (buffer-string)) ;; debugging
(shell-command-on-region (point-min) (point-max) "ruby"))
(org-babel-ruby-table-or-string
(with-temp-buffer (insert-file-contents tmp-file) (buffer-string)))))))
;; comint session evaluation
(let* ((full-body
(mapconcat
#'org-babel-chomp
(list body org-babel-ruby-last-value-eval org-babel-ruby-eoe-indicator) "\n"))
(raw (org-babel-comint-with-output buffer org-babel-ruby-eoe-indicator t
(insert full-body) (comint-send-input nil t)))
(results (cdr (member org-babel-ruby-eoe-indicator
(reverse (mapcar #'org-babel-ruby-read-string
(mapcar #'org-babel-trim raw)))))))
(case result-type
(output (mapconcat #'identity (reverse (cdr results)) "\n"))
(value (org-babel-ruby-table-or-string (car results)))))))
(defun org-babel-ruby-read-string (string)
"Strip \\\"s from around ruby string"
(if (string-match "\"\\([^\000]+\\)\"" string)
(match-string 1 string)
string))
(provide 'org-babel-ruby)
;;; org-babel-ruby.el ends here

68
contrib/babel/lisp/langs/org-babel-sass.el Normal file
View File

@ -0,0 +1,68 @@
;;; org-babel-sass.el --- org-babel functions for the sass css generation language
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; For more information on sass see http://sass-lang.com/
;;
;; This accepts a 'file' header argument which is the target of the
;; compiled sass. The default output type for sass evaluation is
;; either file (if a 'file' header argument was given) or scalar if no
;; such header argument was supplied.
;;
;; A 'cmdline' header argument can be supplied to pass arguments to
;; the sass command line.
;;; Requirements:
;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el
;;; Code:
(require 'org-babel)
(require 'sass-mode)
(org-babel-add-interpreter "sass")
(add-to-list 'org-babel-tangle-langs '("sass" "sass"))
(defun org-babel-execute:sass (body params)
"Execute a block of Sass code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Sass source code block")
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(file (cdr (assoc :file params)))
(out-file (or file (make-temp-file "org-babel-sass-out")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-sass-in"))
(cmd (concat "sass " (or cmdline "") in-file " " out-file)))
(with-temp-file in-file (insert body)) (shell-command cmd)
(or file (with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
(defun org-babel-prep-session:sass (session params)
(error "Sass does not support sessions"))
(provide 'org-babel-sass)
;;; org-babel-sass.el ends here

161
contrib/babel/lisp/langs/org-babel-sh.el Normal file
View File

@ -0,0 +1,161 @@
;;; org-babel-sh.el --- org-babel functions for shell evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating shell source code.
;;; Code:
(require 'org-babel)
(require 'shell)
(org-babel-add-interpreter "sh")
(add-to-list 'org-babel-tangle-langs '("sh" "sh" "#!/usr/bin/env sh"))
(defun org-babel-execute:sh (body params)
"Execute a block of Shell commands with org-babel. This
function is called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing Shell source code block")
(let* ((full-body (concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair))))
vars "\n") "\n" body "\n\n")) ;; then the source block body
(session (org-babel-sh-initiate-session session)))
(org-babel-sh-evaluate session full-body result-type)))
(defun org-babel-prep-session:sh (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-sh-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapcar ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair))))
vars)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines))))
;; helper functions
(defun org-babel-sh-var-to-sh (var)
"Convert an elisp var into a string of shell commands
specifying a var of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-sh-var-to-sh var ", ") "]")
(format "%S" var)))
(defun org-babel-sh-table-or-results (results)
"If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
(if (string-match "^\\[.+\\]$" results)
(org-babel-read
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results)))))
results)))
(defvar org-babel-sh-buffers '(:default . nil))
(defun org-babel-sh-session-buffer (session)
(cdr (assoc session org-babel-sh-buffers)))
(defun org-babel-sh-initiate-session-by-key (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(save-window-excursion
(let* ((session (if session (intern session) :default))
(sh-buffer (org-babel-sh-session-buffer session))
(newp (not (org-babel-comint-buffer-livep sh-buffer))))
(if (and sh-buffer (get-buffer sh-buffer) (not (buffer-live-p sh-buffer)))
(setq sh-buffer nil))
(shell sh-buffer)
(when newp
(setq sh-buffer (current-buffer))
(org-babel-comint-wait-for-output sh-buffer))
(setq org-babel-sh-buffers (cons (cons session sh-buffer)
(assq-delete-all session org-babel-sh-buffers)))
session)))
(defun org-babel-sh-initiate-session (&optional session)
(unless (string= session "none")
(org-babel-sh-session-buffer (org-babel-sh-initiate-session-by-key session))))
(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
"Used to indicate that evaluation is has completed.")
(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
"Used to indicate that evaluation is has completed.")
(defun org-babel-sh-evaluate (buffer body &optional result-type)
"Pass BODY to the Shell process in BUFFER. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY."
(if (not session)
;; external process evaluation
(save-window-excursion
(with-temp-buffer
(insert body)
;; (message "buffer=%s" (buffer-string)) ;; debugging
(shell-command-on-region (point-min) (point-max) "sh" 'replace)
(case result-type
(output (buffer-string))
(value ;; TODO: figure out how to return non-output values from shell scripts
(let ((tmp-file (make-temp-file "org-babel-sh"))
(results (buffer-string)))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file))))))
;; comint session evaluation
(let* ((tmp-file (make-temp-file "org-babel-sh"))
(full-body (mapconcat #'org-babel-chomp
(list body org-babel-sh-eoe-indicator) "\n"))
(raw (org-babel-comint-with-output buffer org-babel-sh-eoe-output nil
(insert full-body) (comint-send-input nil t)))
(results (cdr (member org-babel-sh-eoe-output
(reverse (mapcar #'org-babel-sh-strip-weird-long-prompt
(mapcar #'org-babel-trim raw)))))))
;; (message (replace-regexp-in-string "%" "%%" (format "processed-results=%S" results))) ;; debugging
(or (case result-type
(output (org-babel-trim (mapconcat #'org-babel-trim (reverse results) "\n")))
(value (with-temp-file tmp-file (insert (car results)))
(org-babel-import-elisp-from-file tmp-file)))) "")))
(defun org-babel-sh-strip-weird-long-prompt (string)
(while (string-match "^% +[\r\n$]+ *" string)
(setq string (substring string (match-end 0))))
string)
(provide 'org-babel-sh)
;;; org-babel-sh.el ends here

80
contrib/babel/lisp/langs/org-babel-sql.el Normal file
View File

@ -0,0 +1,80 @@
;;; org-babel-sql.el --- org-babel functions for sql evaluation
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Org-Babel support for evaluating sql source code.
;;
;; SQL is somewhat unique in that there are many different engines for
;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this
;; file will have to be implemented engine by engine.
;;
;; Also SQL evaluation generally takes place inside of a database.
;;
;; For now lets just allow a generic ':cmdline' header argument.
;;
;; TODO:
;;
;; - support for sessions
;; - add more useful header arguments (user, passwd, database, etc...)
;; - support for more engines (currently only supports mysql)
;; - what's a reasonable way to drop table data into SQL?
;;
;;; Code:
(require 'org-babel)
(org-babel-add-interpreter "sql")
(add-to-list 'org-babel-tangle-langs '("sql" "sql"))
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with org-babel. This function is
called by `org-babel-execute-src-block' via multiple-value-bind."
(message "executing Sql source code block")
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(cmdline (cdr (assoc :cmdline params)))
(engine (cdr (assoc :engine params)))
(in-file (make-temp-file "org-babel-sql-in"))
(out-file (or (cdr (assoc :out-file params))
(make-temp-file "org-babel-sql-out")))
(command (case (intern engine)
('mysql (format "mysql %s -e \"source %s\" > %s"
(or cmdline "") in-file out-file))
(t (error "no support for the %s sql engine")))))
(with-temp-file in-file (insert body))
(message command)
(shell-command command)
(with-temp-buffer
(org-table-import out-file nil)
(org-table-to-lisp))))
(defun org-babel-prep-session:sql (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "sql sessions not yet implemented"))
(provide 'org-babel-sql)
;;; org-babel-sql.el ends here

112
contrib/babel/lisp/org-babel-comint.el Normal file
View File

@ -0,0 +1,112 @@
;;; org-babel-comint.el --- org-babel functions for interaction with comint buffers
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; These functions build on comint to ease the sending and receiving
;; of commands and results from comint buffers.
;;
;; Note that the buffers in this file are analogous to sessions in
;; org-babel at large.
;;; Code:
(require 'org-babel)
(require 'comint)
(defun org-babel-comint-buffer-livep (buffer)
(let ((buffer (if buffer (get-buffer buffer))))
(and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer)))
(defmacro org-babel-comint-in-buffer (buffer &rest body)
"Check BUFFER with `org-babel-comint-buffer-livep' then execute
body inside the protection of `save-window-excursion' and
`save-match-data'."
(declare (indent 1))
`(save-window-excursion
(save-match-data
(unless (org-babel-comint-buffer-livep ,buffer)
(error (format "buffer %s doesn't exist or has no process" ,buffer)))
(set-buffer ,buffer)
,@body)))
(defmacro org-babel-comint-with-output (buffer eoe-indicator remove-echo &rest body)
"Evaluate BODY in BUFFER, wait until EOE-INDICATOR appears in
output, then return all process output. This ensures that the
filter is removed in case of an error or user `keyboard-quit'
during execution of body."
(declare (indent 3))
`(org-babel-comint-in-buffer ,buffer
(let ((string-buffer ""))
(flet ((my-filt (text) (setq string-buffer (concat string-buffer text))))
;; setup filter
(add-hook 'comint-output-filter-functions 'my-filt)
(unwind-protect
(progn
;; pass FULL-BODY to process
(goto-char (process-mark (get-buffer-process (current-buffer))))
,@body
;; wait for end-of-evaluation indicator
(while (progn
(goto-char comint-last-input-end)
(not (save-excursion
(and (re-search-forward comint-prompt-regexp nil t)
(re-search-forward (regexp-quote ,eoe-indicator) nil t)))))
(accept-process-output (get-buffer-process (current-buffer)))
;; ;; thought this would allow async background running, but I was wrong...
;; (run-with-timer .5 .5 'accept-process-output (get-buffer-process (current-buffer)))
))
;; remove filter
(remove-hook 'comint-output-filter-functions 'my-filt)))
;; remove echo'd FULL-BODY from input
(if (and ,remove-echo
(string-match
(replace-regexp-in-string "\n" "\r\n" (regexp-quote ,full-body)) string-buffer))
(setq raw (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp))))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER The input will not be echoed."
(org-babel-comint-in-buffer buffer
(goto-char (process-mark (get-buffer-process buffer)))
(insert cmd)
(comint-send-input)
(org-babel-comint-wait-for-output buffer)))
(defun org-babel-comint-wait-for-output (buffer)
"Wait until output arrives. Note: this is only safe when
waiting for the result of a single statement (not large blocks of
code)."
(org-babel-comint-in-buffer buffer
(while (progn
(goto-char comint-last-input-end)
(not (and (re-search-forward comint-prompt-regexp nil t)
(goto-char (match-beginning 0))
(string= (face-name (face-at-point))
"comint-highlight-prompt"))))
(accept-process-output (get-buffer-process buffer)))))
(provide 'org-babel-comint)
;;; org-babel-comint.el ends here

100
contrib/babel/lisp/org-babel-exp.el Normal file
View File

@ -0,0 +1,100 @@
;;; org-babel-exp.el --- Exportation of org-babel source blocks
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; for more information see the comments in org-babel.el
;;; Code:
(require 'org-babel)
(require 'org-exp-blocks)
(org-export-blocks-add-block '(src org-babel-exp-src-blocks nil))
(add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks))
(defun org-babel-exp-src-blocks (body &rest headers)
"Process src block for export. Depending on the 'export'
headers argument in replace the source code block with...
both ---- display the code and the results
code ---- the default, display the code inside the block but do
not process
results - just like none only the block is run on export ensuring
that it's results are present in the org-mode buffer
none ----- do not display either code or results upon export"
(interactive)
(unless headers (error "org-babel can't process a source block without knowing the source code"))
(message "org-babel-exp processing...")
(let* ((lang (car headers))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(params (org-babel-merge-params
org-babel-default-header-args
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(mapconcat #'identity (cdr headers) " ")))))
(org-babel-exp-do-export lang body params)))
(defun org-babel-exp-inline-src-blocks (start end)
"Process inline src blocks between START and END for export.
See `org-babel-exp-src-blocks' for export options, currently the
options and are taken from `org-babel-defualt-inline-header-args'."
(interactive)
(save-excursion
(goto-char start)
(while (and (< (point) end) (re-search-forward org-babel-inline-src-block-regexp end t))
(let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
(replacement (save-match-data
(org-babel-exp-do-export (first info) (second info) (third info) t))))
(setf end (+ end (- (length replacement)
(+ 6 (length (first info)) (length (second info))))))
(replace-match replacement t t)))))
(defun org-babel-exp-do-export (lang body params &optional inline)
(case (intern (or (cdr (assoc :exports params)) "code"))
('none "")
('code (org-babel-exp-code body lang params inline))
('results (org-babel-exp-results))
('both (concat (org-babel-exp-code body lang params inline)
"\n\n"
(org-babel-exp-results)))))
(defun org-babel-exp-code (body lang params &optional inline)
(if inline
(format "=%s=" body)
(format "#+BEGIN_SRC %s\n%s%s\n#+END_SRC" lang body
(if (string-match "\n$" body) "" "\n"))))
(defun org-babel-exp-results ()
(save-excursion
;; org-exp-blocks places us at the end of the block
(re-search-backward org-babel-src-block-regexp nil t)
(org-babel-execute-src-block) ""))
(provide 'org-babel-exp)
;;; org-babel-exp.el ends here

94
contrib/babel/lisp/org-babel-lob.el Normal file
View File

@ -0,0 +1,94 @@
;;; org-babel-lob.el --- The Library of Babel: off-the-shelf functions for data analysis and plotting using org-babel
;; Copyright (C) 2009 Dan Davison, Eric Schulte
;; Author: Dan Davison, Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; See org-babel.org in the parent directory for more information
;;; Code:
(require 'org-babel)
(require 'org-babel-table)
(defvar org-babel-library-of-babel nil
"Library of source-code blocks. This is an association list.
Populate the library by adding files to `org-babel-lob-files'.")
(defcustom org-babel-lob-files '()
"Files used to populate the `org-babel-library-of-babel'. To
add files to this list use the `org-babel-lob-ingest' command."
:group 'org-babel
:type 'list)
(defun org-babel-lob-ingest (&optional file)
"Add all source-blocks defined in FILE to `org-babel-library-of-babel'."
(interactive "f")
(org-babel-map-source-blocks file
(let ((source-name (intern (org-babel-get-src-block-name)))
(info (org-babel-get-src-block-info)))
(when source-name
(setq org-babel-library-of-babel
(cons (cons source-name info)
(assq-delete-all source-name org-babel-library-of-babel)))))))
;; functions for executing lob one-liners
(defvar org-babel-lob-one-liner-regexp "#\\+lob:[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)[ \t]*\n")
(defun org-babel-lob-execute-maybe ()
"Detect if this is context for a org-babel Library Of Babel
src-block and if so then run the appropriate source block from
the Library."
(interactive)
(let ((info (org-babel-lob-get-info)))
(if info (progn (org-babel-lob-execute info) t) nil)))
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-lob-execute-maybe)
(defun org-babel-lob-get-info ()
"Return the function call supplied on the current Library of
Babel line as a string.
This function is analogous to org-babel-get-src-block-name. For
both functions, after they are called, (match-string 1) matches
the function name, and (match-string 2) matches the function
arguments inside the parentheses. I think perhaps these functions
should be renamed to bring out this similarity, perhaps involving
the word 'call'."
(let ((case-fold-search t))
(save-excursion
(move-beginning-of-line 1)
(if (looking-at org-babel-lob-one-liner-regexp)
(org-babel-clean-text-properties
(format "%s(%s)" (match-string 1) (match-string 2)))))))
(defun org-babel-lob-execute (info)
(let ((params (org-babel-merge-params
org-babel-default-header-args
(org-babel-parse-header-arguments (concat ":var results=" info)))))
(org-babel-execute-src-block nil (list "emacs-lisp" "results" params))))
(provide 'org-babel-lob)
;;; org-babel-lob.el ends here

172
contrib/babel/lisp/org-babel-ref.el Normal file
View File

@ -0,0 +1,172 @@
;;; org-babel-ref.el --- org-babel functions for referencing external data
;; Copyright (C) 2009 Eric Schulte, Dan Davison
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Functions for referencing data from the header arguments of a
;; org-babel block. The syntax of such a reference should be
;;
;; #+VAR: variable-name=file:resource-id
;;
;; - variable-name :: the name of the variable to which the value
;; will be assigned
;;
;; - file :: path to the file containing the resource, or omitted if
;; resource is in the current file
;;
;; - resource-id :: the id or name of the resource
;;
;; So an example of a simple src block referencing table data in the
;; same file would be
;;
;; #+TBLNAME: sandbox
;; | 1 | 2 | 3 |
;; | 4 | org-babel | 6 |
;;
;; #+begin_src emacs-lisp :var table=sandbox
;; (message table)
;; #+end_src
;;
;;; Code:
(require 'org-babel)
(defun org-babel-ref-variables (params)
"Takes a parameter alist, and return an alist of variable
names, and the emacs-lisp representation of the related value."
(mapcar #'org-babel-ref-parse
(delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params))))
(defun org-babel-ref-parse (assignment)
"Parse a variable ASSIGNMENT in a header argument. If the
right hand side of the assignment has a literal value return that
value, otherwise interpret as a reference to an external resource
and find it's value using `org-babel-ref-resolve-reference'.
Return a list with two elements. The first element of the list
will be the name of the variable, and the second will be an
emacs-lisp representation of the value of the variable."
(if (string-match
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*" assignment)
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
(or (org-babel-ref-literal ref)
(org-babel-ref-resolve-reference ref))))))
(defun org-babel-ref-literal (ref)
"Determine if the right side of a header argument variable
assignment is a literal value or is a reference to some external
resource. If REF is literal then return it's value, otherwise
return nil."
(let ((out (org-babel-read ref)))
(if (equal out ref)
(if (string-match "\"\\(.+\\)\"" ref)
(read ref))
out)))
(defun org-babel-ref-resolve-reference (ref)
"Resolve the reference and return its value"
(save-excursion
(let ((case-fold-search t)
type args new-refere new-referent result lob-info)
;; assign any arguments to pass to source block
(when (string-match "^\\(.+?\\)\(\\(.*\\)\)$" ref)
(setq new-refere (match-string 1 ref))
(setq new-referent (match-string 2 ref))
;; (message "new-refere=%S, new-referent=%S" new-refere new-referent) ;; debugging
(when (> (length new-refere) 0)
(if (> (length new-referent) 0)
(setq args (mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args new-referent))))
;; (message "args=%S" args) ;; debugging
(setq ref new-refere)))
(when (string-match "\\(.+\\):\\(.+\\)" ref)
(find-file (match-string 1 ref))
(setf ref (match-string 2 ref)))
(goto-char (point-min))
(if (let ((result_regexp (concat "^#\\+\\(TBL\\|RES\\)NAME:[ \t]*"
(regexp-quote ref) "[ \t]*$"))
(regexp (concat "^#\\+SRCNAME:[ \t]*"
(regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$")))
;; goto ref in the current buffer
(or (and (not args)
(or (re-search-forward result_regexp nil t)
(re-search-forward result_regexp nil t)))
(re-search-forward regexp nil t)
(re-search-backward regexp nil t)
;; check the Library of Babel
(setq lob-info (cdr (assoc (intern ref) org-babel-library-of-babel)))))
(unless lob-info (goto-char (match-beginning 0)))
;; ;; TODO: allow searching for names in other buffers
;; (setq id-loc (org-id-find ref 'marker)
;; buffer (marker-buffer id-loc)
;; loc (marker-position id-loc))
;; (move-marker id-loc nil)
(progn (message (format "reference '%s' not found in this buffer" ref))
(error (format "reference '%s' not found in this buffer" ref))))
(if lob-info
(setq type 'lob)
(while (not (setq type (org-babel-ref-at-ref-p)))
(forward-line 1)
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
(error "reference not found"))))
;; (message "type=%S" type) ;; debugging
(case type
('results-line (org-babel-read-result))
('table (org-babel-read-table))
('source-block
(setq result (org-babel-execute-src-block t nil args))
(if (symbolp result) (format "%S" result) result))
('lob (setq result (org-babel-execute-src-block t lob-info args)))))))
(defun org-babel-ref-split-args (arg-string)
"Split ARG-STRING into top-level arguments of balanced parenthesis."
(let ((index 0) (depth 0) (buffer "") holder return)
;; crawl along string, splitting at any ","s which are on the top level
(while (< index (length arg-string))
(setq holder (substring arg-string index (+ 1 index)))
(setq buffer (concat buffer holder))
(setq index (+ 1 index))
(cond
((string= holder ",")
(when (= depth 0)
(setq return (reverse (cons (substring buffer 0 -1) return)))
(setq buffer "")))
((string= holder "(") (setq depth (+ depth 1)))
((string= holder ")") (setq depth (- depth 1)))))
(mapcar #'org-babel-trim (reverse (cons buffer return)))))
(defun org-babel-ref-at-ref-p ()
"Return the type of reference located at point or nil if none
of the supported reference types are found. Supported reference
types are tables and source blocks."
(cond ((org-at-table-p) 'table)
((looking-at "^#\\+BEGIN_SRC") 'source-block)
((looking-at "^#\\+RESNAME:") 'results-line)))
(provide 'org-babel-ref)
;;; org-babel-ref.el ends here

92
contrib/babel/lisp/org-babel-table.el Normal file
View File

@ -0,0 +1,92 @@
;;; org-babel-table.el --- integration for calling org-babel functions from tables
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Should allow calling functions from org-mode tables using the
;; function `sbe' as so...
;;
;; #+begin_src emacs-lisp :results silent
;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
;; #+end_src
;;
;; #+srcname: fibbd
;; #+begin_src emacs-lisp :var n=2 :results silent
;; (fibbd n)
;; #+end_src
;;
;; | original | fibbd |
;; |----------+--------|
;; | 0 | |
;; | 1 | |
;; | 2 | |
;; | 3 | |
;; | 4 | |
;; | 5 | |
;; | 6 | |
;; | 7 | |
;; | 8 | |
;; | 9 | |
;; #+TBLFM: $2='(sbe 'fibbd (n $1))
;;; Code:
(require 'org-babel)
(defun org-babel-table-truncate-at-newline (string)
(if (and (stringp string) (string-match "[\n\r]" string))
(concat (substring string 0 (match-beginning 0)) "...")
string))
(defmacro sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with all assigning
every variable in VARIABLES. Each element of VARIABLES should be
a two element list, whose first element is the name of the
variable and second element is a string of its value. The
following call to `sbe' would be equivalent to the following
source code block.
(sbe 'source-block (n 2) (m 3))
#+begin_src emacs-lisp :var results=source-block(n=2, m=3) :results silent
results
#+end_src"
(unless (stringp source-block) (setq source-block (symbol-name source-block)))
(org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line
(if (and source-block (> (length source-block) 0))
(let ((params
(eval `(org-babel-parse-header-arguments
(concat ":var results="
,source-block
"("
(mapconcat (lambda (var-spec)
(format "%S=%s" (first var-spec) (second var-spec)))
',variables ", ")
")")))))
(org-babel-execute-src-block t (list "emacs-lisp" "results" params)))
"")))
(provide 'org-babel-table)
;;; org-babel-table.el ends here

242
contrib/babel/lisp/org-babel-tangle.el Normal file
View File

@ -0,0 +1,242 @@
;;; org-babel-tangle.el --- Extract source code from org-mode files
;; Copyright (C) 2009 Dan Davison, Eric Schulte
;; Author: Dan Davison, Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Extract the code from source blocks out into raw source-code files.
;;; Code:
(require 'org-babel)
(defvar org-babel-tangle-langs nil
"Association list matching source-block languages. The car of
each element should be a string indicating the source block
language, and the cdr should be a list containing the extension
shebang(#!) line to use when writing out the language to file,
and an optional flag indicating that the language is not
commentable.")
(defun org-babel-load-file (file)
"Load the contents of the Emacs Lisp source code blocks in the
org-mode formatted FILE. This function will first export the
source code using `org-babel-tangle' and then load the resulting
file using `load-file'."
(flet ((age (file)
(time-to-seconds
(time-subtract (current-time)
(sixth (file-attributes file))))))
(let* ((base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
;; tangle if the org-mode file is newer than the elisp file
(unless (and (file-exists-p exported-file) (> (age file) (age exported-file)))
(org-babel-tangle-file file base-name "emacs-lisp"))
(load-file exported-file)
(message "loaded %s" exported-file))))
(defun org-babel-tangle-file (file &optional target-file lang)
"Extract the bodies of all source code blocks in FILE with
`org-babel-tangle'. Optional argument TARGET-FILE can be used to
specify a default export file for all source blocks. Optional
argument LANG can be used to limit the exported source code
blocks by language."
(save-window-excursion (find-file file) (org-babel-tangle target-file lang)))
(defun org-babel-tangle (&optional target-file lang)
"Extract the bodies of all source code blocks from the current
file into their own source-specific files. Optional argument
TARGET-FILE can be used to specify a default export file for all
source blocks. Optional argument LANG can be used to limit the
exported source code blocks by language."
(interactive)
(save-excursion
(let ((block-counter 0)
path-collector)
(mapc ;; map over all languages
(lambda (by-lang)
(let* ((lang (car by-lang))
(specs (cdr by-lang))
(lang-f (intern (concat
(or (and (cdr (assoc lang org-src-lang-modes))
(symbol-name
(cdr (assoc lang org-src-lang-modes))))
lang)
"-mode")))
(lang-specs (cdr (assoc lang org-babel-tangle-langs)))
(ext (first lang-specs))
(she-bang (second lang-specs))
(commentable (not (third lang-specs))))
(mapc
(lambda (spec)
(let* ((tangle (cdr (assoc :tangle (third spec))))
(base-name (or (cond
((string= "yes" tangle)
(file-name-sans-extension (buffer-file-name)))
((string= "no" tangle) nil)
((> (length tangle) 0) tangle))
target-file))
(file-name (when base-name
(if (string= base-name
(file-name-sans-extension base-name))
(concat base-name "." ext) base-name))))
;; ;; debugging
;; (message "tangle=%S base-name=%S file-name=%S"
;; tangle base-name file-name)
(when file-name
;; delete any old versions of file
(when (and (file-exists-p file-name)
(not (member file-name path-collector)))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(funcall lang-f)
(when she-bang (insert (concat she-bang "\n")))
(when commentable
(comment-region
(point) (progn (insert "generated by org-babel-tangle") (point)))
(move-end-of-line nil))
(org-babel-spec-to-string spec)
(append-to-file nil nil file-name))
;; update counter
(setq block-counter (+ 1 block-counter))
(add-to-list 'path-collector file-name))))
specs)))
(org-babel-tangle-collect-blocks lang))
(message "tangled %d code block%s" block-counter
(if (= block-counter 1) "" "s"))
path-collector)))
(defun org-babel-tangle-clean ()
"Call this function inside of a source-code file generated by
`org-babel-tangle' to remove all comments inserted automatically
by `org-babel-tangle'. Warning, this comment removes any lines
containing constructs which resemble org-mode file links or noweb
references."
(interactive)
(goto-char (point-min))
(while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
(re-search-forward "<<[^[:space:]]*>>" nil t))
(delete-region (save-excursion (move-beginning-of-line 1) (point))
(save-excursion (move-end-of-line 1) (forward-char 1) (point)))))
(defun org-babel-tangle-collect-blocks (&optional lang)
"Collect all source blocks in the current org-mode file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
Optional argument LANG can be used to limit the collected source
code blocks by language."
(let ((block-counter 0) blocks)
(org-babel-map-source-blocks (buffer-file-name)
(setq block-counter (+ 1 block-counter))
(let* ((link (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties (car (pop org-stored-links)))))
(source-name (intern (or (org-babel-get-src-block-name)
(format "block-%d" block-counter))))
(info (org-babel-get-src-block-info))
(src-lang (first info))
(body (org-babel-expand-noweb-references info))
(params (third info))
(spec (list link source-name params body (third (cdr (assoc src-lang org-babel-tangle-langs)))))
by-lang)
(unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip
(unless (and lang (not (string= lang src-lang))) ;; maybe limit by language
;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks)))
(setq blocks (delq (assoc src-lang blocks) blocks))
(setq blocks (cons (cons src-lang (cons spec by-lang)) blocks))))))
;; ensure blocks in the correct order
(setq blocks
(mapcar (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) blocks))
;; blocks should contain all source-blocks organized by language
;; (message "blocks=%S" blocks) ;; debugging
blocks))
(defun org-babel-spec-to-string (spec)
"Insert the source-code specified by SPEC into the current
source code file. This function uses `comment-region' which
assumes that the appropriate major-mode is set. SPEC has the
form
(link source-name params body)"
(flet ((insert-comment (text)
(when commentable
(comment-region (point) (progn (insert text) (point)))
(move-end-of-line nil))))
(let ((link (first spec))
(source-name (second spec))
(body (fourth spec))
(commentable (not (fifth spec))))
(insert "\n\n")
(insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
(insert (format "\n%s\n" (org-babel-chomp body)))
(insert-comment (format "%s ends here" source-name))
(insert "\n"))))
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"This function expands Noweb style references in the body of
the current source-code block. For example the following
reference would be replaced with the body of the source-code
block named 'example-block' (assuming the '#' character starts a
comment) .
# <<example-block>>
This function must be called from inside of the buffer containing
the source-code block which holds BODY."
(let* ((parent-buffer (or parent-buffer (current-buffer)))
(info (or info (org-babel-get-src-block-info)))
(lang (first info))
(body (second info))
(new-body "") index source-name)
(flet ((nb-add (text)
(setq new-body (concat new-body text))))
(with-temp-buffer
(insert body) (goto-char (point-min))
(funcall (intern (concat (or (and (cdr (assoc lang org-src-lang-modes))
(symbol-name
(cdr (assoc lang org-src-lang-modes))))
lang) "-mode")))
(setq index (point))
(while (and (re-search-forward "<<\\(.+\\)>>" nil t))
(save-match-data (setf source-name (match-string 1)))
;; add interval to new-body
(goto-char (match-end 0)) (move-end-of-line nil)
(nb-add (buffer-substring index (point)))
(setq index (point))
;; if found, add body of referenced source-block
(nb-add (save-excursion
(set-buffer parent-buffer)
(let ((point (org-babel-find-named-block source-name)))
(if point
(save-excursion
(goto-char point)
(concat "\n" (org-babel-expand-noweb-references
(org-babel-get-src-block-info))))
"")))))
(nb-add (buffer-substring index (point-max)))))
new-body))
(provide 'org-babel-tangle)
;;; org-babel-tangle.el ends here

756
contrib/babel/lisp/org-babel.el Normal file
View File

@ -0,0 +1,756 @@
;;; org-babel.el --- facilitating communication between programming languages and people
;; Copyright (C) 2009 Eric Schulte, Dan Davison
;; Author: Eric Schulte, Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; See org-babel.org in the parent directory for more information
;;; Code:
(require 'org)
(defun org-babel-execute-src-block-maybe ()
"Detect if this is context for a org-babel src-block and if so
then run `org-babel-execute-src-block'."
(interactive)
(let ((info (org-babel-get-src-block-info)))
(if info (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)))
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe)
(defadvice org-edit-special (around org-babel-prep-session-for-edit activate)
"Prepare the current source block's session according to it's
header arguments before editing in an org-src buffer. This
function is called when `org-edit-special' is called with a
prefix argument from inside of a source-code block."
(when current-prefix-arg
(let* ((info (org-babel-get-src-block-info))
(lang (first info))
(params (third info))
(session (cdr (assoc :session params))))
(when (and info session) ;; if we are in a source-code block which has a session
(funcall (intern (concat "org-babel-prep-session:" lang)) session params))))
ad-do-it)
(defadvice org-open-at-point (around org-babel-open-at-point activate)
"If `point' is on a source code block, then open that block's
results with `org-babel-open-src-block-results', otherwise defer
to `org-open-at-point'."
(interactive "P")
(or (call-interactively #'org-babel-open-src-block-result) ad-do-it))
(defun org-babel-pop-to-session-maybe ()
"Detect if this is context for a org-babel src-block and if so
then run `org-babel-pop-to-session'."
(interactive)
(let ((info (org-babel-get-src-block-info)))
(if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
(defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code"))
"Default arguments to use when evaluating a source block.")
(defvar org-babel-default-inline-header-args '((:results . "silent") (:exports . "code"))
"Default arguments to use when evaluating an inline source block.")
(defvar org-babel-src-block-regexp nil
"Regexp used to test when inside of a org-babel src-block")
(defvar org-babel-inline-src-block-regexp nil
"Regexp used to test when on an inline org-babel src-block")
(defvar org-babel-min-lines-for-block-output 10
"If number of lines of output is equal to or exceeds this
value, the output is placed in a
#+begin_example...#+end_example block. Otherwise the output is
marked as literal by inserting colons at the starts of the
lines. This variable only takes effect if the :results output
option is in effect.")
(defun org-babel-named-src-block-regexp-for-name (name)
"Regexp used to match named src block."
(concat "#\\+srcname:[ \t]*" (regexp-quote name) "[ \t\n]*"
(substring org-babel-src-block-regexp 1)))
(defun org-babel-set-interpreters (var value)
(set-default var value)
(setq org-babel-src-block-regexp
(concat "^[ \t]*#\\+begin_src \\("
(mapconcat 'regexp-quote value "\\|")
"\\)[ \t]*"
"\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments
"\\([^\000]+?\\)#\\+end_src"))
(setq org-babel-inline-src-block-regexp
(concat "src_\\("
(mapconcat 'regexp-quote value "\\|")
"\\)"
"\\(\\|\\[\\(.*\\)\\]\\)"
"{\\([^\n]+\\)}")))
(defun org-babel-add-interpreter (interpreter)
"Add INTERPRETER to `org-babel-interpreters' and update
`org-babel-src-block-regexp' appropriately."
(unless (member interpreter org-babel-interpreters)
(setq org-babel-interpreters (cons interpreter org-babel-interpreters))
(org-babel-set-interpreters 'org-babel-interpreters org-babel-interpreters)))
(defcustom org-babel-interpreters '()
"Interpreters allows for evaluation tags.
This is a list of program names (as strings) that can evaluate code and
insert the output into an Org-mode buffer. Valid choices are
R Evaluate R code
emacs-lisp Evaluate Emacs Lisp code and display the result
sh Pass command to the shell and display the result
perl The perl interpreter
python The python interpreter
ruby The ruby interpreter
The source block regexp `org-babel-src-block-regexp' is updated
when a new interpreter is added to this list through the
customize interface. To add interpreters to this variable from
lisp code use the `org-babel-add-interpreter' function."
:group 'org-babel
:set 'org-babel-set-interpreters
:type '(set :greedy t
(const "R")
(const "emacs-lisp")
(const "sh")
(const "perl")
(const "python")
(const "ruby")))
;;; functions
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block, and dump the results
into the buffer immediately following the block. Results are
commented by `org-toggle-fixed-width-section'. With optional
prefix don't dump results into buffer but rather return the
results in raw elisp (this is useful for automated execution of a
source block).
Optionally supply a value for INFO in the form returned by
`org-babel-get-src-block-info'.
Optionally supply a value for PARAMS which will be merged with
the header arguments specified at the source code block."
(interactive)
;; (message "supplied params=%S" params) ;; debugging
(let* ((info (or info (org-babel-get-src-block-info)))
(lang (first info))
(body (second info))
(params (org-babel-merge-params
(third info) (org-babel-get-src-block-function-args) params))
(processed-params (org-babel-process-params params))
(result-params (third processed-params))
(result-type (fourth processed-params))
(cmd (intern (concat "org-babel-execute:" lang)))
result)
;; (message "params=%S" params) ;; debugging statement
(unless (member lang org-babel-interpreters)
(error "Language is not in `org-babel-interpreters': %s" lang))
(when arg (setq result-params (cons "silent" result-params)))
(setq result (multiple-value-bind (session vars result-params result-type) processed-params
(funcall cmd body params)))
(if (eq result-type 'value)
(setq result (org-babel-process-value-result result result-params)))
(org-babel-insert-result result result-params)
(case result-type (output nil) (value result))))
(defun org-babel-pop-to-session (&optional arg info)
"Pop to the session of the current source-code block. If
called with a prefix argument then evaluate the header arguments
for the source block before entering the session. Copy the body
of the source block to the kill ring."
(interactive)
(let* ((info (or info (org-babel-get-src-block-info)))
(lang (first info))
(body (second info))
(params (third info))
(session (cdr (assoc :session params))))
(unless (member lang org-babel-interpreters)
(error "Language is not in `org-babel-interpreters': %s" lang))
;; copy body to the kill ring
(with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max)))
;; if called with a prefix argument, then process header arguments
(if arg (funcall (intern (concat "org-babel-prep-session:" lang)) session params))
;; just to the session using pop-to-buffer
(pop-to-buffer (funcall (intern (format "org-babel-%s-initiate-session" lang)) session))
(move-end-of-line 1)))
(defun org-babel-open-src-block-result (&optional re-run)
"If `point' is on a src block then open the results of the
source code block, otherwise return nil. With optional prefix
argument RE-RUN the source-code block is evaluated even if
results already exist."
(interactive "P")
(when (org-babel-get-src-block-info)
(save-excursion
;; go to the results, if there aren't any then run the block
(goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
(progn (org-babel-execute-src-block)
(org-babel-where-is-src-block-result))))
(move-end-of-line 1) (forward-char 1)
;; open the results
(if (looking-at org-bracket-link-regexp)
;; file results
(org-open-at-point)
(let ((results (org-babel-read-result)))
(flet ((echo-res (result)
(if (stringp result) result (format "%S" result))))
(pop-to-buffer (get-buffer-create "org-babel-results"))
(delete-region (point-min) (point-max))
(if (listp results)
;; table result
(insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res)))
;; scalar result
(insert (echo-res results))))))
t)))
(defun org-babel-process-value-result (result result-params)
"Process returned value for insertion in buffer.
Currently, this function forces to table output if :results
vector has been supplied.
You can see below the various fragments of results-processing
code that were present in the language-specific files. Out of
those fragments, I've moved the org-babel-python-table-or-results
and org-babel-import-elisp-from-file functionality into the
org-babel-*-evaluate functions. I think those should only be used
in the :results value case, as in the 'output case we are not
concerned with creating elisp versions of results. "
(if (and (member "vector" result-params) (not (listp result)))
(list (list result))
result))
(defun org-babel-execute-buffer (&optional arg)
"Replace EVAL snippets in the entire buffer."
(interactive "P")
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
(goto-char (match-beginning 0))
(org-babel-execute-src-block arg)
(goto-char (match-end 0)))))
(defun org-babel-execute-subtree (&optional arg)
"Replace EVAL snippets in the entire subtree."
(interactive "P")
(save-excursion
(org-narrow-to-subtree)
(org-babel-execute-buffer)
(widen)))
(defun org-babel-get-src-block-name ()
"Return the name of the current source block if one exists.
This function is analogous to org-babel-lob-get-info. For both
functions, after they are called, (match-string 1) matches the
function name, and (match-string 3) matches the function
arguments inside the parentheses. I think perhaps these functions
should be renamed to bring out this similarity, perhaps involving
the word 'call'.
Currently the function `org-babel-get-src-block-function-args'
relies on the match-data from a match in this function. I think
splitting a match and the use of it's data is bad form, and we
should re-work these two functions, perhaps combining them into
one function which returns more data than just the name. [Eric]"
(let ((case-fold-search t)
(head (org-babel-where-is-src-block-head)))
(if head
(save-excursion
(goto-char head)
(if (save-excursion
(forward-line -1)
;; the second match of this regexp is used later to
;; find arguments in the "functional" style, where
;; they are passed as part of the source name line
(looking-at "#\\+srcname:[ \f\t\n\r\v]*\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
(org-babel-clean-text-properties (match-string 1)))))))
(defun org-babel-get-src-block-info ()
"Return the information of the current source block as a list
of the following form. (language body header-arguments-alist)"
(let ((case-fold-search t) head)
(if (setq head (org-babel-where-is-src-block-head))
(save-excursion (goto-char head) (org-babel-parse-src-block-match))
(if (save-excursion ;; inline source block
(re-search-backward "[ \f\t\n\r\v]" nil t)
(forward-char 1)
(looking-at org-babel-inline-src-block-regexp))
(org-babel-parse-inline-src-block-match)
nil)))) ;; indicate that no source block was found
(defun org-babel-get-src-block-function-args ()
(when (org-babel-get-src-block-name)
(mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args (match-string 3)))))
(defmacro org-babel-map-source-blocks (file &rest body)
"Evaluate BODY forms on each source-block in FILE."
(declare (indent 1))
`(let ((visited-p (get-buffer (file-name-nondirectory ,file))))
(save-window-excursion
(find-file ,file) (goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
(goto-char (match-beginning 0))
(save-match-data ,@body)
(goto-char (match-end 0))))
(unless visited-p (kill-buffer (file-name-nondirectory file)))))
(defun org-babel-params-from-properties ()
"Return an association list of any source block params which
may be specified in the properties of the current outline entry."
(save-match-data
(delq nil
(mapcar
(lambda (header-arg)
(let ((val (org-entry-get (point) header-arg)))
(when val
;; (message "param-from-property %s=%s" header-arg val) ;; debugging statement
(cons (intern (concat ":" header-arg)) val))))
'("results" "exports" "tangle" "var")))))
(defun org-babel-parse-src-block-match ()
(let* ((lang (org-babel-clean-text-properties (match-string 1)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(body (org-babel-clean-text-properties (match-string 4))))
(list lang
;; get src block body removing properties, protective commas, and indentation
(with-temp-buffer
(save-match-data
(insert (org-babel-strip-protective-commas body))
(org-do-remove-indentation)
(buffer-string)))
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-properties)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
(defun org-babel-parse-inline-src-block-match ()
(let* ((lang (org-babel-clean-text-properties (match-string 1)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang
(org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 4)))
(org-babel-merge-params
org-babel-default-inline-header-args
(org-babel-params-from-properties)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
(defun org-babel-parse-header-arguments (arg-string)
"Parse a string of header arguments returning an alist."
(if (> (length arg-string) 0)
(delq nil
(mapcar
(lambda (arg)
(if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg)
(cons (intern (concat ":" (match-string 1 arg)))
(org-babel-chomp (match-string 2 arg)))
(cons (intern (concat ":" arg)) nil)))
(split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
(defun org-babel-process-params (params)
"Parse params and resolve references.
Return a list (session vars result-params result-type). These are
made available to the org-babel-execute:LANG functions via
multiple-value-bind."
(let* ((session (cdr (assoc :session params)))
(vars (org-babel-ref-variables params))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value)
(t 'value))))
(list session vars result-params result-type)))
(defun org-babel-where-is-src-block-head ()
"Return the point at the beginning of the current source
block. Specifically at the beginning of the #+BEGIN_SRC line.
If the point is not on a source block then return nil."
(let ((initial (point)) top bottom)
(or
(save-excursion ;; on a #+srcname: line
(beginning-of-line 1)
(and (looking-at "#\\+srcname") (forward-line 1)
(looking-at org-babel-src-block-regexp)
(point)))
(save-excursion ;; on a #+begin_src line
(beginning-of-line 1)
(and (looking-at org-babel-src-block-regexp)
(point)))
(save-excursion ;; inside a src block
(and
(re-search-backward "#\\+begin_src" nil t) (setq top (point))
(re-search-forward "#\\+end_src" nil t) (setq bottom (point))
(< top initial) (< initial bottom)
(goto-char top) (looking-at org-babel-src-block-regexp)
(point))))))
(defun org-babel-goto-named-source-block (&optional name)
"Go to a named source-code block."
(interactive "ssource-block name: ")
(let ((point (org-babel-find-named-block name)))
(if point
;; taken from `org-open-at-point'
(progn (goto-char point) (org-show-context))
(message "source-code block '%s' not found in this buffer" name))))
(defun org-babel-find-named-block (name)
"Find a named source-code block.
Return the location of the source block identified by
#+srcname NAME, or nil if no such block exists. Set match data
according to org-babel-named-src-block-regexp."
(save-excursion
(let ((case-fold-search t)
(regexp (org-babel-named-src-block-regexp-for-name name)) msg)
(goto-char (point-min))
(when (or (re-search-forward regexp nil t)
(re-search-backward regexp nil t))
(match-beginning 0)))))
(defun org-babel-find-named-result (name)
"Return the location of the result named NAME in the current
buffer or nil if no such result exists."
(save-excursion
(goto-char (point-min))
(when (re-search-forward ;; ellow end-of-buffer in following regexp?
(concat "#\\+resname:[ \t]*" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
(move-beginning-of-line 0) (point))))
(defun org-babel-where-is-src-block-result (&optional insert)
"Return the point at the beginning of the result of the current
source block. Specifically at the beginning of the #+RESNAME:
line. If no result exists for this block then create a
#+RESNAME: line following the source block."
(save-excursion
(let* ((on-lob-line (progn (beginning-of-line 1)
(looking-at org-babel-lob-one-liner-regexp)))
(name (if on-lob-line (org-babel-lob-get-info) (org-babel-get-src-block-name)))
(head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
(when head (goto-char head))
(or (and name (org-babel-find-named-result name))
(and (or on-lob-line (re-search-forward "#\\+end_src" nil t))
(progn (move-end-of-line 1)
(if (eobp) (insert "\n") (forward-char 1))
(setq end (point))
(or (progn ;; either an unnamed #+resname: line already exists
(re-search-forward "[^ \f\t\n\r\v]" nil t)
(move-beginning-of-line 1) (looking-at "#\\+resname:"))
;; or (with optional insert) we need to back up and make one ourselves
(when insert
(goto-char end) (open-line 2) (forward-char 1)
(insert (concat "#+resname:" (if name (concat " " name))))
(move-beginning-of-line 1) t)))
(point))))))
(defun org-babel-read-result ()
"Read the result at `point' into emacs-lisp."
(cond
((org-at-table-p) (org-babel-read-table))
((looking-at ": ")
(let ((result-string
(org-babel-trim
(mapconcat (lambda (line) (if (and (> (length line) 1)
(string= ": " (substring line 0 2)))
(substring line 2)
line))
(split-string
(buffer-substring (point) (org-babel-result-end)) "[\r\n]+")
"\n"))))
(or (org-babel-number-p result-string) result-string)))
((looking-at "^#\\+RESNAME:")
(save-excursion (forward-line 1) (org-babel-read-result)))))
(defun org-babel-read-table ()
"Read the table at `point' into emacs-lisp."
(mapcar (lambda (row)
(if (and (symbolp row) (equal row 'hline)) row
(mapcar #'org-babel-read row)))
(org-table-to-lisp)))
(defun org-babel-insert-result (result &optional insert)
"Insert RESULT into the current buffer after the end of the
current source block. With optional argument INSERT controls
insertion of results in the org-mode file. INSERT can take the
following values...
replace - (default option) insert results after the source block
replacing any previously inserted results
silent -- no results are inserted
file ---- the results are interpreted as a file path, and are
inserted into the buffer using the Org-mode file syntax
raw ----- results are added directly to the org-mode file. This
is a good option if you code block will output org-mode
formatted text.
org ----- this is the same as the 'raw' option
html ---- results are added inside of a #+BEGIN_HTML block. This
is a good option if you code block will output html
formatted text.
latex --- results are added inside of a #+BEGIN_LATEX block.
This is a good option if you code block will output
latex formatted text."
(if (stringp result)
(progn
(setq result (org-babel-clean-text-properties result))
(if (member "file" insert) (setq result (org-babel-result-to-file result))))
(unless (listp result) (setq result (format "%S" result))))
(if (and insert (member "replace" insert) (not (member "silent" insert)))
(org-babel-remove-result))
(if (= (length result) 0)
(if (member "value" result-params)
(message "No result returned by source block")
(message "Source block produced no output"))
(if (and insert (member "silent" insert))
(progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
(when (and (stringp result) ;; ensure results end in a newline
(not (or (string-equal (substring result -1) "\n")
(string-equal (substring result -1) "\r"))))
(setq result (concat result "\n")))
(save-excursion
(let ((existing-result (org-babel-where-is-src-block-result t)))
(when existing-result (goto-char existing-result) (forward-line 1)))
(if (stringp result) ;; assume the result is a table if it's not a string
(if (member "file" insert)
(insert result)
(if (member "html" insert)
(insert (format "#+BEGIN_HTML\n%s#+END_HTML\n" result))
(if (member "latex" insert)
(insert (format "#+BEGIN_LaTeX\n%s#+END_LaTeX\n" result))
(if (or (member "raw" insert) (member "org" insert))
(progn (save-excursion (insert result))
(if (org-at-table-p) (org-cycle)))
(org-babel-examplize-region (point) (progn (insert result) (point)))))))
(progn
(insert
(concat (orgtbl-to-orgtbl
(if (and (listp (car result)) (listp (cdr (car result))))
result (list result))
'(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
(forward-line -1)
(org-cycle))))
(message "finished"))))
(defun org-babel-result-to-org-string (result)
"Return RESULT as a string in org-mode format. This function
relies on `org-babel-insert-result'."
(with-temp-buffer (org-babel-insert-result result) (buffer-string)))
(defun org-babel-remove-result ()
"Remove the result of the current source block."
(interactive)
(save-excursion
(goto-char (org-babel-where-is-src-block-result t)) (forward-line 1)
(delete-region (save-excursion (move-beginning-of-line 0) (point)) (org-babel-result-end))))
(defun org-babel-result-end ()
"Return the point at the end of the current set of results"
(save-excursion
(if (org-at-table-p)
(progn (goto-char (org-table-end)) (forward-line 1) (point))
(let ((case-fold-search t))
(cond
((looking-at "#\\+begin_latex")
(search-forward "#+end_latex" nil t)
(forward-line 2))
((looking-at "#\\+begin_html")
(search-forward "#+end_html" nil t)
(forward-line 2))
((looking-at "#\\+begin_example")
(search-forward "#+end_example" nil t)
(forward-line 2))
(t (progn (while (looking-at "\\(: \\|\\[\\[\\)")
(forward-line 1))
(forward-line 1)))))
(point))))
(defun org-babel-result-to-file (result)
"Return an `org-mode' link with the path being the value or
RESULT, and the display being the `file-name-nondirectory' if
non-nil."
(concat "[[file:" result "]]"))
(defun org-babel-examplize-region (beg end)
"Comment out region using the ': ' org example quote."
(interactive "*r")
(let ((size (abs (- (line-number-at-pos end)
(line-number-at-pos beg)))))
(save-excursion
(cond ((= size 0)
(error "This should be impossible: a newline was appended to result if missing")
(let ((result (buffer-substring beg end)))
(delete-region beg end)
(insert (concat ": " result))))
((< size org-babel-min-lines-for-block-output)
(goto-char beg)
(dotimes (n size)
(move-beginning-of-line 1) (insert ": ") (forward-line 1)))
(t
(goto-char beg)
(insert "#+begin_example\n")
(forward-char (- end beg))
(insert "#+end_example\n"))))))
(defun org-babel-merge-params (&rest plists)
"Combine all parameter association lists in PLISTS. Later
elements of PLISTS override the values of previous element. This
takes into account some special considerations for certain
parameters when merging lists."
(let (params results exports tangle vars var ref)
(flet ((e-merge (exclusive-groups &rest result-params)
;; maintain exclusivity of mutually exclusive parameters
(let (output)
(mapc (lambda (new-params)
(mapc (lambda (new-param)
(mapc (lambda (exclusive-group)
(when (member new-param exclusive-group)
(mapcar (lambda (excluded-param)
(setq output (delete excluded-param output)))
exclusive-group)))
exclusive-groups)
(setq output (org-uniquify (cons new-param output))))
new-params))
result-params)
output)))
(mapc (lambda (plist)
(mapc (lambda (pair)
(case (car pair)
(:var
;; we want only one specification per variable
(when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair))
;; TODO: When is this not true?
(setq var (intern (match-string 1 (cdr pair)))
ref (match-string 2 (cdr pair))
vars (cons (cons var ref) (assq-delete-all var vars)))))
(:results
(setq results (e-merge
'(("file" "vector" "scalar" "raw" "org" "html" "latex")
("replace" "silent")
("output" "value"))
results (split-string (cdr pair)))))
(:exports
(setq exports (e-merge '(("code" "results" "both" "none"))
exports (split-string (cdr pair)))))
(:tangle
(setq tangle (e-merge '(("yes" "no"))
tangle (split-string (cdr pair)))))
(t ;; replace: this covers e.g. :session
(setq params (cons pair (assq-delete-all (car pair) params))))))
plist))
plists))
(setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
(while vars (setq params (cons (cons :var (pop vars)) params)))
(cons (cons :tangle (mapconcat 'identity tangle " "))
(cons (cons :exports (mapconcat 'identity exports " "))
(cons (cons :results (mapconcat 'identity results " "))
params)))))
(defun org-babel-clean-text-properties (text)
"Strip all properties from text return."
(set-text-properties 0 (length text) nil text) text)
(defun org-babel-strip-protective-commas (body)
"Strip protective commas from bodies of source blocks."
(replace-regexp-in-string "^,#" "#" body))
(defun org-babel-read (cell)
"Convert the string value of CELL to a number if appropriate.
Otherwise if cell looks like lisp (meaning it starts with a
\"(\" or a \"'\") then read it as lisp, otherwise return it
unmodified as a string.
This is taken almost directly from `org-read-prop'."
(if (and (stringp cell) (not (equal cell "")))
(or (org-babel-number-p cell)
(if (or (equal "(" (substring cell 0 1))
(equal "'" (substring cell 0 1)))
(read cell)
(progn (set-text-properties 0 (length cell) nil cell) cell)))
cell))
(defun org-babel-number-p (string)
"Return t if STRING represents a number"
(if (and (string-match "^-?[[:digit:]]*\\.?[[:digit:]]*$" string)
(= (match-end 0) (length string)))
(string-to-number string)))
(defun org-babel-import-elisp-from-file (file-name)
"Read the results located at FILE-NAME into an elisp table. If
the table is trivial, then return it as a scalar."
(let (result)
(with-temp-buffer
(condition-case nil
(progn
(org-table-import file-name nil)
(delete-file file-name)
(setq result (mapcar (lambda (row)
(mapcar #'org-babel-string-read row))
(org-table-to-lisp))))
(error nil)))
(if (null (cdr result)) ;; if result is trivial vector, then scalarize it
(if (consp (car result))
(if (null (cdr (car result)))
(caar result)
result)
(car result))
result)))
(defun org-babel-string-read (cell)
"Strip nested \"s from around strings in exported R values."
(org-babel-read (or (and (stringp cell)
(string-match "\\\"\\(.+\\)\\\"" cell)
(match-string 1 cell))
cell)))
(defun org-babel-reverse-string (string)
(apply 'string (reverse (string-to-list string))))
(defun org-babel-chomp (string &optional regexp)
"Remove any trailing space or carriage returns characters from
STRING. Default regexp used is \"[ \f\t\n\r\v]\" but can be
overwritten by specifying a regexp as a second argument."
(while (and (> (length string) 0) (string-match "[ \f\t\n\r\v]" (substring string -1)))
(setq string (substring string 0 -1)))
string)
(defun org-babel-trim (string &optional regexp)
"Like `org-babel-chomp' only it runs on both the front and back of the string"
(org-babel-chomp (org-babel-reverse-string
(org-babel-chomp (org-babel-reverse-string string) regexp)) regexp))
(provide 'org-babel)
;;; org-babel.el ends here

68
contrib/lisp/org-babel-init.el Normal file
View File

@ -0,0 +1,68 @@
;;; org-babel-init.el --- loads org-babel
;; Copyright (C) 2009 Eric Schulte
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;; Version: 0.01
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; for more information see the comments in org-babel.el
;;; Code:
(let* ((babel-dir (expand-file-name
"lisp"
(expand-file-name
"babel"
(expand-file-name
".." (file-name-directory (or load-file-name buffer-file-name))))))
(langs-dir (expand-file-name "langs" babel-dir))
(load-path (append
(list babel-dir langs-dir)
(or load-path nil))))
;; org-babel core
(require 'cl)
(require 'org)
(require 'org-exp-blocks)
(require 'org-babel)
(require 'org-babel-ref)
(require 'org-babel-exp)
(require 'org-babel-table)
(require 'org-babel-comint)
(require 'org-babel-lob)
(require 'org-babel-tangle)
;; org-babel languages
(require 'org-babel-emacs-lisp)
(require 'org-babel-sh)
;; Library of babel
(defvar org-babel-lob-dir
(expand-file-name ".." babel-dir)
"The directory holding the library-of-babel")
(defun org-babel-load-library-of-babel ()
(org-babel-lob-ingest (expand-file-name "library-of-babel.org" org-babel-lob-dir))))
(provide 'org-babel-init)
;;; org-babel-init.el ends here