mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

This commit is contained in:
Carsten Dominik 2010-10-21 19:35:09 +02:00
parent e40903a6b6 5591fb2cde
commit b0fae37687
50 changed files with 1037 additions and 775 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
ORGWEBPAGE/Changes.org
View File

@ -6,6 +6,78 @@
#+STARTUP: indent hidestars
* Version 7.02
** Incompatible Changes
*** Code block hashes
Due to changes in the code resolving code block header arguments
hashing of code block results should now re-run a code block when
an argument to the code block has changed. As a result of this
change *all* code blocks with cached results will be re-run after
upgrading to the latest version.
*** Testing update
Anyone using the org-mode test suite will need to update the jump
repository for test navigation by executing the following from
the root of the org-mode repository.
: git submodule update
Failure to update this repository will cause loading of
org-test.el to throw errors.
** Details
*** Multi-line header arguments to code blocks
Code block header arguments can now span multiple lines using the
new =#+header:= or =#+headers:= lines preceding a code block or
nested in between the name and body of a named code block.
Examples are given below.
- multi-line header arguments on an un-named code block
: #+headers: :var data1=1
: #+begin_src emacs-lisp :var data2=2
: (message "data1:%S, data2:%S" data1 data2)
: #+end_src
:
: #+results:
: : data1:1, data2:2
- multi-line header arguments on a named code block
: #+source: named-block
: #+header: :var data=2
: #+begin_src emacs-lisp
: (message "data:%S" data)
: #+end_src
:
: #+results: named-block
: : data:2
*** Unified handling of variable expansion for code blocks
The code used to resolve variable references in code block header
arguments has now been consolidated. This both simplifies the
code base (especially the language-specific files), and ensures
that the arguments to a code block will not be evaluated multiple
times. This change should not be externally visible to the
Org-mode user.
*** Improved Caching
Code block caches now notice if the value of a variable argument
to the code block has changed, if this is the case the cache is
invalidated and the code block is re-run. The following example
can provide intuition for the new behavior.
#+begin_src org :exports code
,#+srcname: random
,#+begin_src R :cache yes
,runif(1)
,#+end_src
,#+results[a2a72cd647ad44515fab62e144796432793d68e1]: random
,: 0.4659510825295
,#+srcname: caller
,#+begin_src emacs-lisp :var x=random :cache yes
,x
,#+end_src
,#+results[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller
,: 0.254227238707244
#+end_src
* Version 7.01
:PROPERTIES:
:VISIBILITY: content
@ -445,7 +517,6 @@ Org-babel now supports three new header arguments, and new
default behavior for handling horizontal lines in tables
(hlines), column names, and rownames across all languages.
* Version 6.35
:PROPERTIES:
:CUSTOM_ID: v6.35
@ -1043,7 +1114,6 @@ around org-babel.
- Allow pdf/png generation directly from latex source blocks
with :file header argument.
* Version 6.34
:PROPERTIES:
:CUSTOM_ID: v6.34

8
doc/org.texi
View File

@ -456,7 +456,7 @@ Using header arguments
* Buffer-wide header arguments:: Set default values for a specific buffer
* Header arguments in Org-mode properties:: Set default values for a buffer or heading
* Code block specific header arguments:: The most common way to set values
* Header arguments in function calls::
* Header arguments in function calls:: The most specific level
Specific header arguments
@ -1077,13 +1077,11 @@ after the end of the subtree.
Just like @kbd{M-@key{RET}}, except when adding a new heading below the
current heading, the new heading is placed after the body instead of before
it. This command works from anywhere in the entry.
@kindex M-S-@key{RET}
@item M-S-@key{RET}
@orgcmd{M-S-@key{RET},org-insert-todo-heading}
@vindex org-treat-insert-todo-heading-as-state-change
Insert new TODO entry with same level as current heading. See also the
variable @code{org-treat-insert-todo-heading-as-state-change}.
@kindex C-S-@key{RET}
@item C-S-@key{RET}
@orgcmd{C-S-@key{RET},org-insert-todo-heading-respect-content}
Insert new TODO entry with same level as current heading. Like
@kbd{C-@key{RET}}, the new headline will be inserted after the current
subtree.

25
lisp/ob-C.el
View File

@ -64,26 +64,25 @@ is currently being evaluated.")
called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c++ (body params &optional processed-params)
(defun org-babel-expand-body:c++ (body params)
"Expand a block of C++ code with org-babel according to it's
header arguments (calls `org-babel-C-expand')."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params processed-params)))
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
(defun org-babel-execute:C (body params)
"Execute a block of C code with org-babel. This function is
called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c (body params &optional processed-params)
(defun org-babel-expand-body:c (body params)
"Expand a block of C code with org-babel according to it's
header arguments (calls `org-babel-C-expand')."
(let ((org-babel-c-variant 'c)) (org-babel-C-expand body params processed-params)))
(let ((org-babel-c-variant 'c)) (org-babel-C-expand body params)))
(defun org-babel-C-execute (body params)
"This function should only be called by `org-babel-execute:C'
or `org-babel-execute:c++'."
(let* ((processed-params (org-babel-process-params params))
(tmp-src-file (org-babel-temp-file
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
(cond
((equal org-babel-c-variant 'c) ".c")
@ -106,31 +105,29 @@ or `org-babel-execute:c++'."
(org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results)
(org-babel-reassemble-table
(if (member "vector" (nth 2 processed-params))
(if (member "vector" (cdr (assoc :result-params params)))
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file))
(org-babel-read results))
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params)))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-C-expand (body params &optional processed-params)
(defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to
it's header arguments."
(let ((vars (nth 1 (or processed-params
(org-babel-process-params params))))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(main-p (not (string= (cdr (assoc :main params)) "no")))
(includes (or (cdr (assoc :includes params))
(org-babel-read (org-entry-get nil "includes" t))))
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
(org-babel-trim
(mapconcat 'identity
(list
;; includes
@ -146,7 +143,7 @@ it's header arguments."
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n"))))
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
"Wrap body in a \"main\" function call if none exists."

70
lisp/ob-R.el
View File

@ -38,6 +38,7 @@
(declare-function inferior-ess-send-input "ext:ess-inf" ())
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function org-number-sequence "org-compat" (from &optional to inc))
(defconst org-babel-header-arg-names:R
'(width height bg units pointsize antialias quality compression
@ -50,21 +51,11 @@
(defvar org-babel-R-command "R --slave --no-save"
"Name of command to use for executing R code.")
(defun org-babel-expand-body:R (body params &optional processed-params)
(defun org-babel-expand-body:R (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((processed-params (or processed-params
(org-babel-process-params params)))
(vars (mapcar
(lambda (i)
(cons (car (nth i (nth 1 processed-params)))
(org-babel-reassemble-table
(cdr (nth i (nth 1 processed-params)))
(cdr (nth i (nth 4 processed-params)))
(cdr (nth i (nth 5 processed-params))))))
(org-number-sequence 0 (1- (length (nth 1 processed-params))))))
(out-file (cdr (assoc :file params))))
(mapconcat ;; define any variables
#'org-babel-trim
(let (out-file (cdr (assoc :file params)))
(mapconcat
#'identity
((lambda (inside)
(if out-file
(append
@ -72,49 +63,36 @@
inside
(list "dev.off()"))
inside))
(append
(mapcar
(lambda (pair)
(org-babel-R-assign-elisp
(car pair) (cdr pair)
(equal "yes" (cdr (assoc :colnames params)))
(equal "yes" (cdr (assoc :rownames params)))))
vars)
(list body))) "\n")))
(append (org-babel-variable-assignments:R params)
(list body))) "\n")))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
This function is called by `org-babel-execute-src-block'."
(save-excursion
(let* ((processed-params (org-babel-process-params params))
(result-type (nth 3 processed-params))
(let* ((result-type (cdr (assoc :result-type params)))
(session (org-babel-R-initiate-session
(first processed-params) params))
(cdr (assoc :session params)) params))
(colnames-p (cdr (assoc :colnames params)))
(rownames-p (cdr (assoc :rownames params)))
(out-file (cdr (assoc :file params)))
(full-body (org-babel-expand-body:R body params processed-params))
(full-body (org-babel-expand-body:R body params))
(result
(org-babel-R-evaluate
session full-body result-type
(or (equal "yes" colnames-p)
(org-babel-pick-name (nth 4 processed-params) colnames-p))
(org-babel-pick-name
(cdr (assoc :colname-names params)) colnames-p))
(or (equal "yes" rownames-p)
(org-babel-pick-name (nth 5 processed-params) rownames-p)))))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) rownames-p)))))
(message "result is %S" result)
(or out-file result))))
(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 params))
(vars (org-babel-ref-variables params))
(var-lines
(mapcar
(lambda (pair) (org-babel-R-assign-elisp
(car pair) (cdr pair)
(equal (cdr (assoc :colnames params)) "yes")
(equal (cdr (assoc :rownames params)) "yes")))
vars)))
(var-lines (org-babel-variable-assignments:R params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)
@ -132,6 +110,24 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:R (params)
"Return list of R statements assigning the block's variables"
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapcar
(lambda (pair)
(org-babel-R-assign-elisp
(car pair) (cdr pair)
(equal "yes" (cdr (assoc :colnames params)))
(equal "yes" (cdr (assoc :rownames params)))))
(mapcar
(lambda (i)
(cons (car (nth i vars))
(org-babel-reassemble-table
(cdr (nth i vars))
(cdr (nth i (cdr (assoc :colname-names params))))
(cdr (nth i (cdr (assoc :rowname-names params)))))))
(org-number-sequence 0 (1- (length vars)))))))
(defun org-babel-R-quote-tsv-field (s)
"Quote field S for export to R."
(if (stringp s)

19
lisp/ob-asymptote.el
View File

@ -55,18 +55,10 @@
'((:results . "file") (:exports . "results"))
"Default arguments when evaluating an Asymptote source block.")
(defun org-babel-expand-body:asymptote (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params
(org-babel-process-params params)))))
(concat (mapconcat 'org-babel-asymptote-var-to-asymptote vars "\n")
"\n" body "\n")))
(defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (cdr (assoc :file params)))
(format (or (and out-file
(string-match ".+\\.\\(.+\\)" out-file)
@ -84,7 +76,9 @@ This function is called by `org-babel-execute-src-block'."
" " cmdline
" " (org-babel-process-file-name in-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:asymptote body params processed-params)))
(insert (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:asymptote params))))
(message cmd) (shell-command cmd)
out-file))
@ -93,6 +87,11 @@ This function is called by `org-babel-execute-src-block'."
Asymptote does not support sessions"
(error "Asymptote does not support sessions"))
(defun org-babel-variable-assignments:asymptote (params)
"Return list of asymptote statements assigning the block's variables"
(mapcar #'org-babel-asymptote-var-to-asymptote
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-asymptote-var-to-asymptote (pair)
"Convert an elisp value into an Asymptote variable.
The elisp value PAIR is converted into Asymptote code specifying

18
lisp/ob-clojure.el
View File

@ -45,7 +45,6 @@
(declare-function slime-eval-async "ext:slime" (sexp &optional cont package))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(declare-function swank-clojure-concat-paths "ext:slime" (paths))
(declare-function org-babel-ref-variables "ext:slime" (params))
(declare-function slime "ext:slime" (&optional command coding-system))
(declare-function slime-output-buffer "ext:slime" (&optional noprompt))
(declare-function slime-filter-buffers "ext:slime" (predicate))
@ -155,7 +154,7 @@ code specifying a variable of the same value."
"Prepare SESSION according to the header arguments specified in PARAMS."
(require 'slime) (require 'swank-clojure)
(let* ((session-buf (org-babel-clojure-initiate-session session))
(vars (org-babel-ref-variables params))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(var-lines (mapcar ;; define any top level session variables
(lambda (pair)
(format "(def %s %s)\n" (car pair)
@ -294,24 +293,23 @@ return the value of the last statement in BODY as elisp."
(org-babel-clojure-evaluate-session buffer body result-type)
(org-babel-clojure-evaluate-external-process buffer body result-type)))
(defun org-babel-expand-body:clojure (body params &optional processed-params)
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(org-babel-clojure-build-full-form
body (nth 1 (or processed-params (org-babel-process-params params)))))
body (mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code."
(require 'slime) (require 'swank-clojure)
(let* ((processed-params (org-babel-process-params params))
(body (org-babel-expand-body:clojure body params processed-params))
(let* ((body (org-babel-expand-body:clojure body params))
(session (org-babel-clojure-initiate-session
(first processed-params))))
(cdr (assoc :session params)))))
(org-babel-reassemble-table
(org-babel-clojure-evaluate session body (nth 3 processed-params))
(org-babel-clojure-evaluate session body (cdr (assoc :result-type params)))
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(provide 'ob-clojure)

3
lisp/ob-css.el
View File

@ -32,9 +32,6 @@
(defvar org-babel-default-header-args:css '())
(defun org-babel-expand-body:css (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:css (body params)
"Execute a block of CSS code.
This function is called by `org-babel-execute-src-block'."

3
lisp/ob-ditaa.el
View File

@ -43,9 +43,6 @@
'((:results . "file") (:exports . "results"))
"Default arguments for evaluating a ditaa source block.")
(defun org-babel-expand-body:ditaa (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defvar org-ditaa-jar-path)
(defun org-babel-execute:ditaa (body params)
"Execute a block of Ditaa code with org-babel.

10
lisp/ob-dot.el
View File

@ -46,10 +46,9 @@
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a dot source block.")
(defun org-babel-expand-body:dot (body params &optional processed-params)
(defun org-babel-expand-body:dot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params
(org-babel-process-params params)))))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
@ -65,15 +64,14 @@
(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'."
(let* ((processed-params (org-babel-process-params params))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(let* ((result-params (cdr (assoc :result-params params)))
(out-file (cdr (assoc :file params)))
(cmdline (or (cdr (assoc :cmdline params))
(format "-T%s" (file-name-extension out-file))))
(cmd (or (cdr (assoc :cmd params)) "dot"))
(in-file (org-babel-temp-file "dot-")))
(with-temp-file in-file
(insert (org-babel-expand-body:dot body params processed-params)))
(insert (org-babel-expand-body:dot body params)))
(org-babel-eval
(concat cmd
" " (org-babel-process-file-name in-file)

24
lisp/ob-emacs-lisp.el
View File

@ -36,16 +36,16 @@
(declare-function orgtbl-to-generic "org-table" (table params))
(defun org-babel-expand-body:emacs-lisp (body params &optional processed-params)
(defun org-babel-expand-body:emacs-lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((processed-params (or processed-params (org-babel-process-params params)))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-params (cdr (assoc :result-params params)))
(print-level nil) (print-length nil)
(body (if (> (length vars) 0)
(concat "(let ("
(mapconcat
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
(lambda (var)
(format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n" body ")")
body)))
@ -56,13 +56,13 @@
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
(save-window-excursion
(let ((processed-params (org-babel-process-params params)))
(org-babel-reassemble-table
(eval (read (format "(progn %s)"
(org-babel-expand-body:emacs-lisp
body params processed-params))))
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
(org-babel-reassemble-table
(eval (read (format "(progn %s)"
(org-babel-expand-body:emacs-lisp body params))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params))))))
(provide 'ob-emacs-lisp)

167
lisp/ob-exp.el
View File

@ -77,6 +77,30 @@ be indented by this many characters. See
`org-babel-function-def-export-name' for the definition of a
source block function.")
(defmacro org-babel-exp-in-export-file (&rest body)
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(heading (nth 4 (ignore-errors (org-heading-components))))
(link (when org-current-export-file
(org-make-link-string
(if heading
(concat org-current-export-file "::" heading)
org-current-export-file))))
(export-buffer (current-buffer)) results)
(when link
;; resolve parameters in the original file so that
;; headline and file-wide parameters are included, attempt
;; to go to the same heading in the original file
(set-buffer (get-file-buffer org-current-export-file))
(save-restriction
(condition-case nil
(org-open-link-from-string link)
(error (when heading
(goto-char (point-min))
(re-search-forward (regexp-quote heading) nil t))))
(setq results ,@body))
(set-buffer export-buffer)
results)))
(defun org-babel-exp-src-blocks (body &rest headers)
"Process source block for export.
Depending on the 'export' headers argument in replace the source
@ -95,51 +119,27 @@ none ----- do not display either code or results upon export"
(message "org-babel-exp processing...")
(save-excursion
(goto-char (match-beginning 0))
(let* ((raw-header (match-string 3))
(info (org-babel-get-src-block-info))
(let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info))
(lang-headers
(intern (concat "org-babel-default-header-args:" lang)))
(raw-params
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(mapconcat #'identity (cdr (split-string raw-header)) " "))))
(heading (nth 4 (ignore-errors (org-heading-components))))
(link (when org-current-export-file
(org-make-link-string
(if heading
(concat org-current-export-file "::" heading)
org-current-export-file))))
(export-buffer (current-buffer)))
(raw-params (nth 2 info)))
;; bail if we couldn't get any info from the block
(when info
(when link
;; resolve parameters in the original file so that headline
;; and file-wide parameters are included
;; attempt to go to the same heading in the original file
(set-buffer (get-file-buffer org-current-export-file))
(save-restriction
(condition-case nil
(org-open-link-from-string link)
(error (when heading
(goto-char (point-min))
(re-search-forward (regexp-quote heading) nil t))))
(setf (nth 2 info)
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params)))
(set-buffer export-buffer))
(org-babel-exp-in-export-file
(setf (nth 2 info)
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params)))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb (nth 2 info)))
(string= "yes" (cdr (assoc :noweb (nth 2 info)))))
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
(nth 1 info))))
(org-babel-exp-do-export info 'block))))
(nth 1 info)))
(org-babel-exp-do-export info 'block)))))
(defun org-babel-exp-inline-src-blocks (start end)
"Process inline source blocks between START and END for export.
@ -249,9 +249,7 @@ The code block is not evaluated."
(body (nth 1 info))
(switches (nth 3 info))
(name (nth 4 info))
(args (mapcar
#'cdr
(org-remove-if-not (lambda (el) (eq :var (car el))) (nth 2 info)))))
(args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var))))
(case type
('inline (format "=%s=" body))
('block
@ -283,62 +281,45 @@ Results are prepared in a manner suitable for export by org-mode.
This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer."
(if org-export-babel-evaluate
(let ((lang (nth 0 info))
(body (nth 1 info))
(params
;; lets ensure that we lookup references in the original file
(mapcar
(lambda (pair)
(if (and org-current-export-file
(eq (car pair) :var)
(string-match org-babel-ref-split-regexp (cdr pair))
(equal :ob-must-be-reference
(org-babel-ref-literal
(match-string 2 (cdr pair)))))
`(:var . ,(concat (match-string 1 (cdr pair))
"=" org-current-export-file
":" (match-string 2 (cdr pair))))
pair))
(nth 2 info))))
;; skip code blocks which we can't evaluate
(if (fboundp (intern (concat "org-babel-execute:" lang)))
(case type
('inline
(let ((raw (org-babel-execute-src-block
nil info '((:results . "silent"))))
(result-params (split-string
(cdr (assoc :results params)))))
(unless silent
(cond ;; respect the value of the :results header argument
((member "file" result-params)
(org-babel-result-to-file raw))
((or (member "raw" result-params)
(member "org" result-params))
(format "%s" raw))
((member "code" result-params)
(format "src_%s{%s}" lang raw))
(t
(if (stringp raw)
(if (= 0 (length raw)) "=(no results)="
(format "%s" raw))
(format "%S" raw)))))))
('block
(org-babel-execute-src-block
nil info (org-babel-merge-params
params
`((:results . ,(if silent "silent" "replace")))))
"")
('lob
(or
(when org-export-babel-evaluate
(let ((lang (nth 0 info))
(body (nth 1 info)))
(setf (nth 2 info) (org-babel-exp-in-export-file
(org-babel-process-params (nth 2 info))))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(if (equal type 'inline)
(let ((raw (org-babel-execute-src-block
nil info '((:results . "silent"))))
(result-params (split-string
(cdr (assoc :results (nth 2 info))))))
(unless silent
(cond ;; respect the value of the :results header argument
((member "file" result-params)
(org-babel-result-to-file raw))
((or (member "raw" result-params)
(member "org" result-params))
(format "%s" raw))
((member "code" result-params)
(format "src_%s{%s}" lang raw))
(t
(if (stringp raw)
(if (= 0 (length raw)) "=(no results)="
(format "%s" raw))
(format "%S" raw))))))
(prog1 nil
(setf (nth 2 info)
(org-babel-merge-params
(nth 2 info)
`((:results . ,(if silent "silent" "replace")))))
(cond
((equal type 'block) (org-babel-execute-src-block nil info))
((equal type 'lob)
(save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t)
(org-babel-execute-src-block
nil info (org-babel-merge-params
params
`((:results . ,(if silent "silent" "replace")))))
"")))
""))
""))
(org-babel-execute-src-block nil info)))))))))
""))
(provide 'ob-exp)

21
lisp/ob-gnuplot.el
View File

@ -70,9 +70,9 @@ code."
(org-babel-gnuplot-table-to-data
(cdr pair) (org-babel-temp-file "gnuplot-") params)
(cdr pair))))
(org-babel-ref-variables params)))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-expand-body:gnuplot (body params &optional processed-params)
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
@ -118,9 +118,9 @@ code."
;; 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"))
(add-to-body (mapconcat #'identity
(org-babel-variable-assignments:gnuplot params)
"\n"))
;; replace any variable names preceded by '$' with the actual
;; value of the variable
(mapc (lambda (pair)
@ -162,10 +162,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:gnuplot (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(let* ((session (org-babel-gnuplot-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines (mapcar
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
vars)))
(var-lines (org-babel-variable-assignments:gnuplot params)))
(message "%S" session)
(org-babel-comint-in-buffer session
(mapc (lambda (var-line)
@ -183,6 +180,12 @@ This function is called by `org-babel-execute-src-block'."
(insert (org-babel-chomp body)))
buffer)))
(defun org-babel-variable-assignments:gnuplot (params)
"Return list of gnuplot statements assigning the block's variables"
(mapcar
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
(mapcar #'cdr (org-babel-get-header params :var))))
(defvar gnuplot-buffer)
(defun org-babel-gnuplot-initiate-session (&optional session params)
"Initiate a gnuplot session.

58
lisp/ob-haskell.el
View File

@ -59,23 +59,14 @@
(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"")
(defun org-babel-expand-body:haskell (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat
(lambda (pair) (format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code."
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(vars (nth 1 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:haskell body params processed-params))
(let* ((session (cdr (assoc :session params)))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:haskell params)))
(session (org-babel-haskell-initiate-session session params))
(raw (org-babel-comint-with-output
(session org-babel-haskell-eoe t full-body)
@ -93,8 +84,10 @@
(mapconcat #'identity (reverse (cdr results)) "\n"))
((equal result-type 'value)
(org-babel-haskell-table-or-string (car results))))
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colname-names params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rowname-names params))))))
(defun org-babel-haskell-read-string (string)
"Strip \\\"s from around a haskell string."
@ -110,34 +103,35 @@ then create one. Return the initialized session."
(or (get-buffer "*haskell*")
(save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer))))
(defun org-babel-load-session:haskell
(session body params &optional processed-params)
(defun org-babel-load-session:haskell (session body params)
"Load BODY into SESSION."
(save-window-excursion
(let* ((buffer (org-babel-prep-session:haskell
session params processed-params))
(let* ((buffer (org-babel-prep-session:haskell session params))
(load-file (concat (org-babel-temp-file "haskell-load-") ".hs")))
(with-temp-buffer
(insert body) (write-file load-file)
(haskell-mode) (inferior-haskell-load-file))
buffer)))
(defun org-babel-prep-session:haskell
(session params &optional processed-params)
(defun org-babel-prep-session:haskell (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(save-window-excursion
(let ((pp (or processed-params (org-babel-process-params params)))
(buffer (org-babel-haskell-initiate-session session)))
(let ((buffer (org-babel-haskell-initiate-session session)))
(org-babel-comint-in-buffer buffer
(mapc
(lambda (pair)
(insert (format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
(comint-send-input nil t))
(nth 1 pp)))
(mapc (lambda (line)
(insert line)
(comint-send-input nil t))
(org-babel-variable-assignments:haskell params)))
(current-buffer))))
(defun org-babel-variable-assignments:haskell (params)
"Return list of haskell statements assigning the block's variables"
(mapcar (lambda (pair)
(format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var)) "\n"))
(defun org-babel-haskell-table-or-string (results)
"Convert RESULTS to an Emacs-lisp table or string.
If RESULTS look like a table, then convert them into an

35
lisp/ob-js.el
View File

@ -64,27 +64,18 @@
"require('sys').print(require('sys').inspect(function(){%s}()));"
"Javascript code to print value of body.")
(defun org-babel-expand-body:js (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat ;; define any variables
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:js (body params)
"Execute a block of Javascript code with org-babel.
This function is called by `org-babel-execute-src-block'"
(let* ((processed-params (org-babel-process-params params))
(org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:js body params processed-params)))
(let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:js params))))
(org-babel-js-read
(if (not (string= (nth 0 processed-params) "none"))
(if (not (string= (cdr (assoc :session params)) "none"))
;; session evaluation
(let ((session (org-babel-prep-session:js
(nth 0 processed-params) params)))
(cdr (assoc :session params)) params)))
(nth 1
(org-babel-comint-with-output
(session (format "%S" org-babel-js-eoe) t body)
@ -130,12 +121,7 @@ specifying a variable of the same value."
(defun org-babel-prep-session:js (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-js-initiate-session session))
(vars (org-babel-ref-variables params))
(var-lines
(mapcar
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
vars)))
(var-lines (org-babel-variable-assignments:js params)))
(when session
(org-babel-comint-in-buffer session
(sit-for .5) (goto-char (point-max))
@ -145,6 +131,13 @@ specifying a variable of the same value."
(sit-for .1) (goto-char (point-max))) var-lines)))
session))
(defun org-babel-variable-assignments:js (params)
"Return list of Javascript statements assigning the block's variables"
(mapcar
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-js-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."

3
lisp/ob-keys.el
View File

@ -83,7 +83,8 @@ functions which are assigned key bindings, and see
("a" . org-babel-sha1-hash)
("h" . org-babel-describe-bindings)
("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
("x" . org-babel-do-key-sequence-in-edit-buffer))
("x" . org-babel-do-key-sequence-in-edit-buffer)
("\C-\M-h" . org-babel-mark-block))
"Alist of key bindings and interactive Babel functions.
This list associates interactive Babel functions
with keys. Each element of this list will add an entry to the

4
lisp/ob-latex.el
View File

@ -53,7 +53,7 @@
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
(defun org-babel-expand-body:latex (body params &optional processed-params)
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
(mapc (lambda (pair) ;; replace variables
(setq body
@ -61,7 +61,7 @@
(regexp-quote (format "%S" (car pair)))
(if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair)))
body))) (nth 1 (org-babel-process-params params)))
body))) (mapcar #'cdr (org-babel-get-header params :var)))
(org-babel-trim body))
(defun org-babel-execute:latex (body params)

12
lisp/ob-lisp.el
View File

@ -49,9 +49,9 @@
(defcustom org-babel-lisp-cmd "sbcl --script"
"Name of command used to evaluate lisp blocks.")
(defun org-babel-expand-body:lisp (body params &optional processed-params)
(defun org-babel-expand-body:lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(if (> (length vars) 0)
(concat "(let ("
(mapconcat
@ -64,10 +64,10 @@
"Execute a block of Lisp code with org-babel.
This function is called by `org-babel-execute-src-block'"
(message "executing Lisp source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-lisp-initiate-session (first processed-params)))
(result-type (fourth processed-params))
(full-body (org-babel-expand-body:lisp body params processed-params)))
(let* ((session (org-babel-lisp-initiate-session
(cdr (assoc :session params))))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:lisp body params)))
(read
(if session
;; session evaluation

22
lisp/ob-lob.el
View File

@ -50,7 +50,7 @@ To add files to this list use the `org-babel-lob-ingest' command."
(interactive "f")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
(let* ((info (org-babel-get-src-block-info))
(let* ((info (org-babel-get-src-block-info 'light))
(source-name (nth 4 info)))
(when source-name
(setq source-name (intern source-name)
@ -59,7 +59,8 @@ To add files to this list use the `org-babel-lob-ingest' command."
(assq-delete-all source-name org-babel-library-of-babel))
lob-ingest-count (1+ lob-ingest-count)))))
(message "%d src block%s added to Library of Babel"
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))))
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
lob-ingest-count))
(defconst org-babel-lob-call-aliases '("lob" "call")
"Aliases to call a source block function.
@ -100,14 +101,15 @@ if so then run the appropriate source block from the Library."
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
(let ((params (org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results="
(mapconcat #'identity (butlast info) " ")))))))
(let ((params (org-babel-process-params
(org-babel-merge-params
org-babel-default-header-args
(org-babel-params-from-buffer)
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(concat ":var results="
(mapconcat #'identity (butlast info) " "))))))))
(org-babel-execute-src-block
nil (list "emacs-lisp" "results" params nil nil (nth 2 info)))))

3
lisp/ob-mscgen.el
View File

@ -62,9 +62,6 @@
'((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a mscgen source block.")
(defun org-babel-expand-body:mscgen (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:mscgen (body params)
"Execute a block of Mscgen code with Babel.
This function is called by `org-babel-execute-src-block'.

27
lisp/ob-ocaml.el
View File

@ -51,20 +51,12 @@
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
(defun org-babel-expand-body:ocaml (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
(let* ((processed-params (org-babel-process-params params))
(vars (nth 1 processed-params))
(full-body (org-babel-expand-body:ocaml body params processed-params))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:ocaml params)))
(session (org-babel-prep-session:ocaml
(cdr (assoc :session params)) params))
(raw (org-babel-comint-with-output
@ -84,9 +76,9 @@
(org-babel-reassemble-table
(org-babel-ocaml-parse-output (org-babel-trim clean))
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defvar tuareg-interactive-buffer-name)
(defun org-babel-prep-session:ocaml (session params)
@ -100,6 +92,13 @@
(save-window-excursion (tuareg-run-caml)
(get-buffer tuareg-interactive-buffer-name))))
(defun org-babel-variable-assignments:ocaml (params)
"Return list of ocaml statements assigning the block's variables"
(mapcar
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-ocaml-elisp-to-ocaml (val)
"Return a string of ocaml code which evaluates to VAL."
(if (listp val)

56
lisp/ob-octave.el
View File

@ -47,20 +47,6 @@
(defvar org-babel-octave-shell-command "octave -q"
"Shell command to run octave as an external process.")
(defun org-babel-expand-body:matlab (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(org-babel-expand-body:octave body params processed-params))
(defun org-babel-expand-body:octave (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
vars "\n") "\n" body "\n")))
(defvar org-babel-matlab-with-emacs-link nil
"If non-nil use matlab-shell-run-region for session evaluation.
This will use EmacsLink if (matlab-with-emacs-link) evaluates
@ -89,31 +75,43 @@ end")
(defun org-babel-execute:octave (body params &optional matlabp)
"Execute a block of octave code with Babel."
(let* ((processed-params (org-babel-process-params params))
(session
(let* ((session
(funcall (intern (format "org-babel-%s-initiate-session"
(if matlabp "matlab" "octave")))
(nth 0 processed-params) params))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(cdr (assoc :session params)) params))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(out-file (cdr (assoc :file params)))
(augmented-body
(org-babel-expand-body:octave body params processed-params))
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:octave params)))
(result (org-babel-octave-evaluate
session augmented-body result-type matlabp)))
session full-body result-type matlabp)))
(or out-file
(org-babel-reassemble-table
result
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params)))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:matlab (session params)
"Prepare SESSION according to PARAMS."
(org-babel-prep-session:octave session params 'matlab))
(defun org-babel-variable-assignments:octave (params)
"Return list of octave statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defalias 'org-babel-variable-assignments:matlab
'org-babel-variable-assignments:octave)
(defun org-babel-octave-var-to-octave (var)
"Convert an emacs-lisp value into an octave variable.
Converts an emacs-lisp variable into a string of octave code
@ -126,13 +124,7 @@ specifying a variable of the same value."
(defun org-babel-prep-session:octave (session params &optional matlabp)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-octave-initiate-session session params matlabp))
(vars (org-babel-ref-variables params))
(var-lines (mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
vars)))
(var-lines (org-babel-variable-assignments:octave params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)

3
lisp/ob-org.el
View File

@ -41,9 +41,6 @@
"#+TITLE: default empty header\n"
"Default header inserted during export of org blocks.")
(defun org-babel-expand-body:org (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:org (body params)
"Execute a block of Org code with.
This function is called by `org-babel-execute-src-block'."

36
lisp/ob-perl.el
View File

@ -38,39 +38,35 @@
(defvar org-babel-perl-command "perl"
"Name of command to use for executing perl code.")
(defun org-babel-expand-body:perl (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "$%s=%s;"
(car pair)
(org-babel-perl-var-to-perl (cdr pair))))
vars "\n") "\n" (org-babel-trim body) "\n")))
(defun org-babel-execute:perl (body params)
"Execute a block of Perl code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:perl
body params processed-params))
(let* ((session (cdr (assoc :session params)))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:perl params)))
(session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type)
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(defun org-babel-prep-session:perl (session params)
"Prepare SESSION according to the header arguments in PARAMS."
(error "Sessions are not supported for Perl."))
(defun org-babel-variable-assignments:perl (params)
"Return list of perl statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "$%s=%s;"
(car pair)
(org-babel-perl-var-to-perl (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
;; helper functions
(defun org-babel-perl-var-to-perl (var)

3
lisp/ob-plantuml.el
View File

@ -42,9 +42,6 @@
'((:results . "file") (:exports . "results"))
"Default arguments for evaluating a plantuml source block.")
(defun org-babel-expand-body:plantuml (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defcustom org-plantuml-jar-path nil
"Path to the plantuml.jar file."
:group 'org-babel

50
lisp/ob-python.el
View File

@ -48,48 +48,33 @@
"Preferred python mode for use in running python interactively.")
(defvar org-src-preserve-indentation)
(defun org-babel-expand-body:python (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
(nth 1 (or processed-params (org-babel-process-params params))) "\n")
"\n"
(org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))
"\n"))
(defun org-babel-execute:python (body params)
"Execute a block of Python code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-python-initiate-session (first processed-params)))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:python
body params processed-params))
(let* ((session (org-babel-python-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:python params)))
(result (org-babel-python-evaluate
session full-body result-type result-params)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params)
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params)
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments in PARAMS."
"Prepare SESSION according to the header arguments in PARAMS.
VARS contains resolved variable references"
(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)))
(var-lines
(org-babel-variable-assignments:python params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input)
@ -107,6 +92,15 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:python (params)
"Return list of python statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-python-var-to-python (var)
"Convert an elisp value to a python variable.
Convert an elisp value, VAR, into a string of python source code

62
lisp/ob-ref.el
View File

@ -57,36 +57,26 @@
(declare-function org-at-table-p "org" (&optional table-type))
(declare-function org-count "org" (CL-ITEM CL-SEQ))
(defun org-babel-ref-variables (params)
"Convert PARAMS to variable names and values.
Takes a parameter alist, and return an alist of variable names,
and the emacs-lisp representation of the related value."
(let ((assignments
(delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params)))
(others
(delq nil (mapcar (lambda (pair) (unless (eq :var (car pair)) pair)) params))))
(mapcar (lambda (assignment) (org-babel-ref-parse assignment)) assignments)))
(defvar org-babel-ref-split-regexp
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
(defun org-babel-ref-parse (assignment &optional 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 org-babel-ref-split-regexp assignment)
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
((lambda (val)
(if (equal :ob-must-be-reference val)
(org-babel-ref-resolve-reference ref params)
val)) (org-babel-ref-literal ref))))))
`org-babel-ref-resolve'. 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."
(when (string-match org-babel-ref-split-regexp assignment)
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
((lambda (val)
(if (equal :ob-must-be-reference val)
(org-babel-ref-resolve ref) val))
(org-babel-ref-literal ref))))))
(defun org-babel-ref-literal (ref)
"Return the value of REF if it is a literal value.
@ -103,7 +93,7 @@ return nil."
out)))
(defvar org-babel-library-of-babel)
(defun org-babel-ref-resolve-reference (ref &optional params)
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
(save-excursion
(let ((case-fold-search t)
@ -119,12 +109,10 @@ return nil."
(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)
(setq split-file (match-string 1 ref))
@ -133,7 +121,8 @@ return nil."
(save-restriction
(widen)
(goto-char (point-min))
(if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME\\|RESULTS\\):[ \t]*"
(if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME"
"\\|RESULTS\\):[ \t]*"
(regexp-quote ref) "[ \t]*$"))
(regexp (concat org-babel-src-name-regexp
(regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$")))
@ -144,7 +133,8 @@ return nil."
(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)))))
(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)
@ -159,14 +149,14 @@ return nil."
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
(error "reference not found"))))
(setq params (org-babel-merge-params params args '((:results . "silent"))))
(setq result
(case type
('results-line (org-babel-read-result))
('table (org-babel-read-table))
('file (org-babel-read-link))
('source-block (org-babel-execute-src-block nil nil params))
('lob (org-babel-execute-src-block nil lob-info params))))
(let ((params (append args '((:results . "silent")))))
(setq result
(case type
('results-line (org-babel-read-result))
('table (org-babel-read-table))
('file (org-babel-read-link))
('source-block (org-babel-execute-src-block nil nil params))
('lob (org-babel-execute-src-block nil lob-info params)))))
(if (symbolp result)
(format "%S" result)
(if (and index (listp result))

44
lisp/ob-ruby.el
View File

@ -52,47 +52,30 @@
(defvar org-babel-ruby-command "ruby"
"Name of command to use for executing ruby code.")
(defun org-babel-expand-body:ruby (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(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")))
(defun org-babel-execute:ruby (body params)
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-ruby-initiate-session (first processed-params)))
(result-params (nth 2 processed-params))
(result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:ruby
body params processed-params))
(let* ((session (org-babel-ruby-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:ruby params)))
(result (org-babel-ruby-evaluate
session full-body result-type result-params)))
(or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params)
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params)
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))))
(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)))
(var-lines (org-babel-variable-assignments:ruby params)))
(org-babel-comint-in-buffer session
(sit-for .5) (goto-char (point-max))
(mapc (lambda (var)
@ -112,6 +95,15 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:ruby (params)
"Return list of ruby statements assigning the block's variables"
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-ruby-var-to-ruby (var)
"Convert VAR into a ruby variable.
Convert an elisp value into a string of ruby source code

5
lisp/ob-sass.el
View File

@ -43,9 +43,6 @@
(defvar org-babel-default-header-args:sass '())
(defun org-babel-expand-body:sass (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:sass (body params)
"Execute a block of Sass code with Babel.
This function is called by `org-babel-execute-src-block'."
@ -58,7 +55,7 @@ This function is called by `org-babel-execute-src-block'."
" " (org-babel-process-file-name in-file)
" " (org-babel-process-file-name out-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:sass body params))) (shell-command cmd)
(insert (org-babel-expand-body:generic body params))) (shell-command cmd)
(or file (with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
(defun org-babel-prep-session:sass (session params)

18
lisp/ob-scheme.el
View File

@ -59,9 +59,9 @@
:group 'org-babel
:type 'string)
(defun org-babel-expand-body:scheme (body params &optional processed-params)
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(if (> (length vars) 0)
(concat "(let ("
(mapconcat
@ -74,15 +74,15 @@
(defun org-babel-execute:scheme (body params)
"Execute a block of Scheme code with org-babel.
This function is called by `org-babel-execute-src-block'"
(let* ((processed-params (org-babel-process-params params))
(result-type (nth 3 processed-params))
(org-babel-scheme-cmd (or (cdr (assoc :scheme params)) org-babel-scheme-cmd))
(full-body (org-babel-expand-body:scheme body params processed-params)))
(let* ((result-type (cdr (assoc :result-type params)))
(org-babel-scheme-cmd (or (cdr (assoc :scheme params))
org-babel-scheme-cmd))
(full-body (org-babel-expand-body:scheme body params)))
(read
(if (not (string= (nth 0 processed-params) "none"))
(if (not (string= (cdr (assoc :session params)) "none"))
;; session evaluation
(let ((session (org-babel-prep-session:scheme
(nth 0 processed-params) params)))
(cdr (assoc :session params)) params)))
(org-babel-comint-with-output
(session (format "%S" org-babel-scheme-eoe) t body)
(mapc
@ -104,7 +104,7 @@ This function is called by `org-babel-execute-src-block'"
(defun org-babel-prep-session:scheme (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-scheme-initiate-session session))
(vars (org-babel-ref-variables params))
(vars (mapcar #'cdr (org-babel-get-header params :var)))
(var-lines
(mapcar
(lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))

13
lisp/ob-screen.el
View File

@ -45,28 +45,21 @@ In case you want to use a different screen than one selected by your $PATH")
'((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm"))
"Default arguments to use when running screen source blocks.")
(defun org-babel-expand-body:screen (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:screen (body params)
"Send a block of code via screen to a terminal using Babel.
\"default\" session is used when none is specified."
(message "Sending source code block to interactive terminal session...")
(save-window-excursion
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(let* ((session (cdr (assoc :session params)))
(socket (org-babel-screen-session-socketname session)))
(unless socket (org-babel-prep-session:screen session params))
(org-babel-screen-session-execute-string
session (org-babel-expand-body:screen body params)))))
session (org-babel-expand-body:generic body params)))))
(defun org-babel-prep-session:screen (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((processed-params (org-babel-process-params params))
(session (nth 0 processed-params))
(vars (nth 1 processed-params))
(let* ((session (cdr (assoc :session params)))
(socket (org-babel-screen-session-socketname session))
(vars (org-babel-ref-variables params))
(cmd (cdr (assoc :cmd params)))
(terminal (cdr (assoc :terminal params)))
(process-name (concat "org-babel: terminal (" session ")")))

49
lisp/ob-sh.el
View File

@ -33,7 +33,6 @@
(require 'shell)
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-variables "ob-ref" (params))
(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
@ -46,44 +45,25 @@
"Command used to invoke a shell.
This will be passed to `shell-command-on-region'")
(defun org-babel-expand-body:sh (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params))))
(sep (cdr (assoc :separator params))))
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair) sep)))
vars "\n") (if vars "\n" "") body "\n\n")))
(defun org-babel-execute:sh (body params)
"Execute a block of Shell commands with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-sh-initiate-session (nth 0 processed-params)))
(result-params (nth 2 processed-params))
(full-body (org-babel-expand-body:sh
body params processed-params)))
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
(result-params (cdr (assoc :result-params params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params))))
(org-babel-reassemble-table
(org-babel-sh-evaluate session full-body result-params)
(org-babel-pick-name
(nth 4 processed-params) (cdr (assoc :colnames params)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(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))
(sep (cdr (assoc :separator params)))
(var-lines (mapcar ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair) sep)))
vars)))
(var-lines (org-babel-variable-assignments:sh params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
@ -101,6 +81,16 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:sh (params)
"Return list of shell statements assigning the block's variables"
(let ((sep (cdr (assoc :separator params))))
(mapcar
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-sh-var-to-sh (cdr pair) sep)))
(mapcar #'cdr (org-babel-get-header params :var)))))
(defun org-babel-sh-var-to-sh (var &optional sep)
"Convert an elisp value to a shell variable.
Convert an elisp var into a string of shell commands specifying a
@ -112,7 +102,8 @@ var of the same value."
(org-babel-sh-var-to-sh el sep))))
(format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)"
(orgtbl-to-generic
(deep-string var) (list :sep (or sep "\t")))))
(deep-string (if (listp (car var)) var (list var)))
(list :sep (or sep "\t")))))
(if (stringp var)
(if (string-match "[\n\r]" var)
(format "$(cat <<BABEL_STRING\n%s\nBABEL_STRING\n)" var)

14
lisp/ob-sql.el
View File

@ -50,14 +50,10 @@
(defvar org-babel-default-header-args:sql '())
(defun org-babel-expand-body:sql (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(processed-params (org-babel-process-params params))
(let* ((result-params (cdr (assoc :result-params params)))
(cmdline (cdr (assoc :cmdline params)))
(engine (cdr (assoc :engine params)))
(in-file (org-babel-temp-file "sql-in-"))
@ -74,15 +70,17 @@ This function is called by `org-babel-execute-src-block'."
(or cmdline "")))
(t (error "no support for the %s sql engine" engine)))))
(with-temp-file in-file
(insert (org-babel-expand-body:sql body params)))
(insert (org-babel-expand-body:generic body params)))
(message command)
(shell-command command)
(with-temp-buffer
(org-table-import out-file nil)
(org-babel-reassemble-table
(org-table-to-lisp)
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:sql (session params)

10
lisp/ob-sqlite.el
View File

@ -41,9 +41,10 @@
'(db header echo bail csv column html line list separator nullvalue)
"Sqlite specific header args.")
(defun org-babel-expand-body:sqlite (body params &optional processed-params)
(defun org-babel-expand-body:sqlite (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sqlite-expand-vars
body (or (nth 1 processed-params) (org-babel-ref-variables params))))
body (mapcar #'cdr (org-babel-get-header params :var))))
(defvar org-babel-sqlite3-command "sqlite3")
@ -51,7 +52,7 @@
"Execute a block of Sqlite code with Babel.
This function is called by `org-babel-execute-src-block'."
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(vars (org-babel-ref-variables params))
(vars (org-babel-get-header params :var))
(db (cdr (assoc :db params)))
(separator (cdr (assoc :separator params)))
(nullvalue (cdr (assoc :nullvalue params)))
@ -70,8 +71,7 @@ This function is called by `org-babel-execute-src-block'."
(list
(cons "body" ((lambda (sql-file)
(with-temp-file sql-file
(insert (org-babel-expand-body:sqlite
body nil (list nil vars))))
(insert (org-babel-expand-body:sqlite body params)))
sql-file)
(org-babel-temp-file "sqlite-sql-")))
(cons "cmd" org-babel-sqlite3-command)

37
lisp/ob-table.el
View File

@ -80,22 +80,21 @@ cell's value as a string, prefix the identifier with two \"$\"s
rather than a single \"$\" (i.e. \"$$2\" instead of \"$2\" in the
example above."
(let* (quote
(variables (mapcar
(lambda (var)
;; ensure that all cells prefixed with $'s are strings
(cons (car var)
(delq nil
(mapcar
(lambda (el)
(if (eq '$ el)
(setq quote t)
(prog1
(if quote
(format "\"%s\"" el)
(org-babel-clean-text-properties el))
(setq quote nil))))
(cdr var)))))
variables)))
(variables
(mapcar
(lambda (var)
;; ensure that all cells prefixed with $'s are strings
(cons (car var)
(delq nil (mapcar
(lambda (el)
(if (eq '$ el)
(setq quote t)
(prog1 (if quote
(format "\"%s\"" el)
(org-babel-clean-text-properties el))
(setq quote nil))))
(cdr var)))))
variables)))
(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
@ -109,14 +108,14 @@ example above."
(lambda (var-spec)
(if (> (length (cdr var-spec)) 1)
(format "%S='%S"
(car var-spec) (mapcar #'read (cdr var-spec)))
(car var-spec)
(mapcar #'read (cdr var-spec)))
(format "%S=%s"
(car var-spec) (cadr var-spec))))
',variables ", ")
")")))))
(org-babel-execute-src-block
nil (list "emacs-lisp" "results"
(org-babel-merge-params '((:results . "silent")) params))))
nil (list "emacs-lisp" "results" params) '((:results . "silent"))))
""))))
(provide 'ob-table)

113
lisp/ob-tangle.el
View File

@ -73,7 +73,10 @@ information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
%link --------- Org-mode style link to the code block
%source-name -- name of the code block"
%source-name -- name of the code block
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:type 'string)
@ -84,7 +87,10 @@ information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
%link --------- Org-mode style link to the code block
%source-name -- name of the code block"
%source-name -- name of the code block
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:type 'string)
@ -276,54 +282,63 @@ code blocks by language."
(let* ((start-line (save-restriction (widen)
(+ 1 (line-number-at-pos (point)))))
(file (buffer-file-name))
(info (org-babel-get-src-block-info))
(params (nth 2 info))
(link (unless (string= (cdr (assoc :tangle params)) "no")
(progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(car (pop org-stored-links))))))
(source-name (intern (or (nth 4 info)
(format "%s:%d"
current-heading block-counter))))
(src-lang (nth 0 info))
(expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
(body ((lambda (body)
(if (assoc :no-expand params)
body
(funcall (if (fboundp expand-cmd)
expand-cmd
'org-babel-expand-body:generic)
body params)))
(if (and (cdr (assoc :noweb params))
(let ((nowebs (split-string
(cdr (assoc :noweb params)))))
(or (member "yes" nowebs)
(member "tangle" nowebs))))
(org-babel-expand-noweb-references info)
(nth 1 info))))
(comment (when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
;; from the previous heading or code-block end
(buffer-substring
(max (condition-case nil
(save-excursion
(org-back-to-heading t) (point))
(error 0))
(save-excursion (re-search-backward
org-babel-src-block-regexp nil t)
(match-end 0)))
(point))))
by-lang)
(unless (string= (cdr (assoc :tangle params)) "no")
(info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info)))
(unless (string= (cdr (assoc :tangle (nth 2 info))) "no")
(unless (and language (not (string= language src-lang)))
;; 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 (list start-line file link
source-name params body comment)
by-lang)) blocks))))))
(let* ((info (org-babel-get-src-block-info))
(params (nth 2 info))
(link (progn (call-interactively 'org-store-link)
(org-babel-clean-text-properties
(car (pop org-stored-links)))))
(source-name
(intern (or (nth 4 info)
(format "%s:%d"
current-heading block-counter))))
(expand-cmd
(intern (concat "org-babel-expand-body:" src-lang)))
(assignments-cmd
(intern (concat "org-babel-variable-assignments:" src-lang)))
(body
((lambda (body)
(if (assoc :no-expand params)
body
(if (fboundp expand-cmd)
(funcall expand-cmd body params)
(org-babel-expand-body:generic
body params
(and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
(if (and (cdr (assoc :noweb params))
(let ((nowebs (split-string
(cdr (assoc :noweb params)))))
(or (member "yes" nowebs)
(member "tangle" nowebs))))
(org-babel-expand-noweb-references info)
(nth 1 info))))
(comment
(when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
;; from the previous heading or code-block end
(buffer-substring
(max (condition-case nil
(save-excursion
(org-back-to-heading t) (point))
(error 0))
(save-excursion
(re-search-backward
org-babel-src-block-regexp nil t)
(match-end 0)))
(point))))
by-lang)
;; 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 (list start-line file link
source-name params body comment)
by-lang)) blocks)))))))
;; ensure blocks in the correct order
(setq blocks
(mapcar

376
lisp/ob.el
View File

@ -68,10 +68,9 @@
(declare-function orgtbl-to-orgtbl "org-table" (table params))
(declare-function org-babel-lob-get-info "ob-lob" nil)
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
(declare-function org-babel-ref-variables "ob-ref" (params))
(declare-function org-babel-ref-resolve-reference "ob-ref"
(ref &optional params))
(declare-function org-babel-ref-parse "ob-ref" (assignment))
(declare-function org-babel-lob-execute-maybe "ob-lob" ())
(declare-function org-number-sequence "org-compat" (from &optional to inc))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@ -110,8 +109,15 @@ remove code block execution from the C-c C-c keybinding."
"^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*"
"Regular expression used to match a source name line.")
(defvar org-babel-multi-line-header-regexp
"^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
"Regular expression used to match multi-line header arguments.")
(defvar org-babel-src-name-w-name-regexp
(concat org-babel-src-name-regexp
"\\("
org-babel-multi-line-header-regexp
"\\)*"
"\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
"Regular expression matching source name lines with a name.")
@ -137,34 +143,54 @@ remove code block execution from the C-c C-c keybinding."
"{\\([^\f\n\r\v]+?\\)}\\)")
"Regexp used to identify inline src-blocks.")
(defun org-babel-get-src-block-info ()
(defun org-babel-get-header (params key &optional others)
"Select only header argument of type KEY from a list.
Optional argument OTHERS indicates that only the header that do
not match KEY should be returned."
(delq nil
(mapcar
(lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
params)))
(defun org-babel-get-src-block-info (&optional light)
"Get information on the current source block.
Optional argument LIGHT does not resolve remote variable
references; a process which could likely result in the execution
of other code blocks.
Returns a list
(language body header-arguments-alist switches name function-args indent)."
(let ((case-fold-search t) head info name args indent)
(language body header-arguments-alist switches name indent)."
(let ((case-fold-search t) head info name indent)
;; full code block
(if (setq head (org-babel-where-is-src-block-head))
(save-excursion
(save-excursion
(goto-char head)
(setq info (org-babel-parse-src-block-match))
(setq indent (car (last info)))
(setq info (butlast info))
(forward-line -1)
(when (and (looking-at org-babel-src-name-w-name-regexp)
(setq name (match-string 2)))
(setq name (org-babel-clean-text-properties name))
(when (setq args (match-string 4))
(setq args (mapcar
(lambda (ref) (cons :var ref))
(org-babel-ref-split-args args)))
(setf (nth 2 info)
(org-babel-merge-params args (nth 2 info)))))
(append info (list name args indent)))
(if (save-excursion ;; inline source block
(re-search-backward "[ \f\t\n\r\v]" nil t)
(looking-at org-babel-inline-src-block-regexp))
(org-babel-parse-inline-src-block-match)
nil))))
(while (and (forward-line -1)
(looking-at org-babel-multi-line-header-regexp))
(setf (nth 2 info)
(org-babel-merge-params
(org-babel-parse-header-arguments (match-string 1))
(nth 2 info))))
(when (looking-at org-babel-src-name-w-name-regexp)
(setq name (org-babel-clean-text-properties (match-string 4)))
(when (match-string 5)
(setf (nth 2 info) ;; merge functional-syntax vars and header-args
(org-babel-merge-params
(mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args (match-string 5)))
(nth 2 info))))))
;; inline source block
(when (save-excursion (re-search-backward "[ \f\t\n\r\v]" nil t)
(looking-at org-babel-inline-src-block-regexp))
(setq info (org-babel-parse-inline-src-block-match))))
;; resolve variable references and add summary parameters
(when (and info (not light))
(setf (nth 2 info) (org-babel-process-params (nth 2 info))))
(when info (append info (list name indent)))))
(defun org-babel-confirm-evaluate (info)
"Confirm evaluation of the code block INFO.
@ -249,7 +275,7 @@ then run `org-babel-pop-to-session'."
(defconst org-babel-header-arg-names
'(cache cmdline colnames dir exports file noweb results
session tangle var eval noeval comments)
session tangle var eval noeval comments)
"Common header arguments used by org-babel.
Note that individual languages may define their own language
specific header arguments as well.")
@ -325,25 +351,20 @@ block."
(let ((info (or info (org-babel-get-src-block-info))))
(when (org-babel-confirm-evaluate info)
(let* ((lang (nth 0 info))
(params (setf
(nth 2 info)
(sort (org-babel-merge-params (nth 2 info) params)
(lambda (el1 el2) (string< (symbol-name (car el1))
(symbol-name (car el2)))))))
(new-hash
(if (and (cdr (assoc :cache params))
(string= "yes" (cdr (assoc :cache params))))
(org-babel-sha1-hash info)))
(old-hash (org-babel-result-hash info))
(params (if params
(org-babel-process-params
(org-babel-merge-params (nth 2 info) params))
(nth 2 info)))
(cache? (and (not arg) (cdr (assoc :cache params))
(string= "yes" (cdr (assoc :cache params)))))
(result-params (cdr (assoc :result-params params)))
(new-hash (when cache? (org-babel-sha1-hash info)))
(old-hash (when cache? (org-babel-result-hash info)))
(body (setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info)
(nth 1 info))))
(result-params (split-string (or (cdr (assoc :results params)) "")))
(result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value)
(t 'value)))
(cmd (intern (concat "org-babel-execute:" lang)))
(dir (cdr (assoc :dir params)))
(default-directory
@ -356,7 +377,7 @@ block."
result)
(unwind-protect
(flet ((call-process-region (&rest args)
(apply 'org-babel-tramp-handle-call-process-region args)))
(apply 'org-babel-tramp-handle-call-process-region args)))
(unless (fboundp cmd)
(error "No org-babel-execute function for %s!" lang))
(if (and (not arg) new-hash (equal new-hash old-hash))
@ -370,7 +391,7 @@ block."
(capitalize lang)
(if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
(setq result (funcall cmd body params))
(if (eq result-type 'value)
(if (eq (cdr (assoc :result-type params)) 'value)
(setq result (if (and (or (member "vector" result-params)
(member "table" result-params))
(not (listp result)))
@ -382,12 +403,13 @@ block."
result))
(setq call-process-region 'org-babel-call-process-region-original))))))
(defun org-babel-expand-body:generic (body params &optional processed-params)
(defun org-babel-expand-body:generic (body params &optional var-lines)
"Expand BODY with PARAMS.
Expand a block of code with org-babel according to it's header
arguments. This generic implementation of body expansion is
called for languages which have not defined their own specific
org-babel-expand-body:lang function." body)
org-babel-expand-body:lang function."
(mapconcat #'identity (append var-lines (list body)) "\n"))
;;;###autoload
(defun org-babel-expand-src-block (&optional arg info params)
@ -400,14 +422,17 @@ arguments and pop open the results in a preview buffer."
(params (setf (nth 2 info)
(sort (org-babel-merge-params (nth 2 info) params)
(lambda (el1 el2) (string< (symbol-name (car el1))
(symbol-name (car el2)))))))
(symbol-name (car el2)))))))
(body (setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info) (nth 1 info))))
(cmd (intern (concat "org-babel-expand-body:" lang)))
(expanded (funcall (if (fboundp cmd) cmd 'org-babel-expand-body:generic)
body params)))
(expand-cmd (intern (concat "org-babel-expand-body:" lang)))
(assignments-cmd (intern (concat "org-babel-variable-assignments:" lang)))
(expanded
(if (fboundp expand-cmd) (funcall expand-cmd body params)
(org-babel-expand-body:generic
body params (and (fboundp assignments-cmd) (funcall assignments-cmd params))))))
(org-edit-src-code
nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))))
@ -451,19 +476,19 @@ of the code block to the kill ring."
(dir (cdr (assoc :dir params)))
(default-directory
(or (and dir (file-name-as-directory dir)) default-directory))
(cmd (intern (format "org-babel-%s-initiate-session" lang)))
(cmd2 (intern (concat "org-babel-prep-session:" lang))))
(init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
(prep-cmd (intern (concat "org-babel-prep-session:" lang))))
(if (and (stringp session) (string= session "none"))
(error "This block is not using a session!"))
(unless (fboundp cmd)
(unless (fboundp init-cmd)
(error "No org-babel-initiate-session function for %s!" lang))
(with-temp-buffer (insert (org-babel-trim body))
(copy-region-as-kill (point-min) (point-max)))
(when arg
(unless (fboundp cmd2)
(unless (fboundp prep-cmd)
(error "No org-babel-prep-session function for %s!" lang))
(funcall cmd2 session params))
(funcall cmd session params)))
(funcall prep-cmd session params))
(funcall init-cmd session params)))
;;;###autoload
(defun org-babel-switch-to-session (&optional arg info)
@ -479,20 +504,20 @@ with a prefix argument then this is passed on to
;;;###autoload
(defun org-babel-switch-to-session-with-code (&optional arg info)
"Switch to code buffer and display session."
(interactive "P")
(flet ((swap-windows
()
(let ((other-window-buffer (window-buffer (next-window))))
(set-window-buffer (next-window) (current-buffer))
(set-window-buffer (selected-window) other-window-buffer))
(other-window 1)))
(let ((info (org-babel-get-src-block-info))
(org-src-window-setup 'reorganize-frame))
(save-excursion
(org-babel-switch-to-session arg info))
(org-edit-src-code))
(swap-windows)))
"Switch to code buffer and display session."
(interactive "P")
(flet ((swap-windows
()
(let ((other-window-buffer (window-buffer (next-window))))
(set-window-buffer (next-window) (current-buffer))
(set-window-buffer (selected-window) other-window-buffer))
(other-window 1)))
(let ((info (org-babel-get-src-block-info))
(org-src-window-setup 'reorganize-frame))
(save-excursion
(org-babel-switch-to-session arg info))
(org-edit-src-code))
(swap-windows)))
(defmacro org-babel-do-in-edit-buffer (&rest body)
"Evaluate BODY in edit buffer if there is a code block at point.
@ -577,20 +602,27 @@ the current subtree."
(defun org-babel-sha1-hash (&optional info)
"Generate an sha1 hash based on the value of info."
(interactive)
(let* ((info (or info (org-babel-get-src-block-info)))
(hash (sha1
(format "%s-%s"
(mapconcat
(lambda (arg)
(if (stringp (cdr arg))
(mapconcat
#'identity
(sort (split-string (cdr arg)) #'string<) " ")
(cdr arg)))
(nth 2 info) ":")
(nth 1 info)))))
(when (interactive-p) (message hash))
hash))
(let ((print-level nil)
(info (or info (org-babel-get-src-block-info))))
(setf (nth 2 info)
(sort (nth 2 info)
(lambda (a b) (string< (car a) (car b)))))
(let ((hash (sha1
(format "%s-%s"
(mapconcat
#'identity
(delq nil
(mapcar
(lambda (arg)
(let ((v (cdr arg)))
(when (and v (not (and (sequencep v)
(not (consp v))
(= (length v) 0))))
(format "%S" v))))
(nth 2 info))) ":")
(nth 1 info)))))
(when (interactive-p) (message hash))
hash)))
(defun org-babel-result-hash (&optional info)
"Return the in-buffer hash associated with INFO."
@ -716,7 +748,7 @@ portions of results lines."
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (org-add-hook 'change-major-mode-hook
'org-babel-show-result-all 'append 'local)))
'org-babel-show-result-all 'append 'local)))
(defmacro org-babel-map-src-blocks (file &rest body)
"Evaluate BODY forms on each source-block in FILE.
@ -751,7 +783,7 @@ end-body --------- point at the end of the body"
(goto-char (match-beginning 0))
(let ((full-block (match-string 0))
(beg-block (match-beginning 0))
(end-block (match-beginning 0))
(end-block (match-end 0))
(lang (match-string 2))
(beg-lang (match-beginning 2))
(end-lang (match-end 2))
@ -764,10 +796,9 @@ end-body --------- point at the end of the body"
(body (match-string 5))
(beg-body (match-beginning 5))
(end-body (match-end 5)))
(save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p
(kill-buffer to-be-removed))
,@body
(goto-char end-block))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point)))
(defvar org-file-properties)
@ -868,23 +899,28 @@ may be specified at the top of the current buffer."
(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 colnames rownames)."
(let* ((session (cdr (assoc :session params)))
(vars-and-names (org-babel-disassemble-tables
(org-babel-ref-variables params)
(cdr (assoc :hlines params))
(cdr (assoc :colnames params))
(cdr (assoc :rownames params))))
(vars (car vars-and-names))
(colnames (cadr vars-and-names))
(rownames (caddr vars-and-names))
(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 colnames rownames)))
"Expand variables in PARAMS and add summary parameters."
(let* ((vars-and-names (org-babel-disassemble-tables
(mapcar (lambda (el)
(if (consp (cdr el))
(cdr el) (org-babel-ref-parse (cdr el))))
(org-babel-get-header params :var))
(cdr (assoc :hlines params))
(cdr (assoc :colnames params))
(cdr (assoc :rownames params))))
(result-params (append
(split-string (or (cdr (assoc :results params)) ""))
(cdr (assoc :result-params params)))))
(append
(mapcar (lambda (var) (cons :var var)) (car vars-and-names))
(list
(cons :colname-names (cadr vars-and-names))
(cons :rowname-names (caddr vars-and-names))
(cons :result-params result-params)
(cons :result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value)
(t 'value))))
(org-babel-get-header params :var 'other))))
;; row and column names
(defun org-babel-del-hlines (table)
@ -1053,7 +1089,7 @@ org-babel-named-src-block-regexp."
(when file (find-file file)) (goto-char (point-min))
(let (names)
(while (re-search-forward org-babel-src-name-w-name-regexp nil t)
(setq names (cons (org-babel-clean-text-properties (match-string 2))
(setq names (cons (org-babel-clean-text-properties (match-string 3))
names)))
names)))
@ -1115,6 +1151,18 @@ With optional prefix argument ARG, jump backward ARG many source blocks."
(defvar org-babel-load-languages)
;;;###autoload
(defun org-babel-mark-block ()
"Mark current src block"
(interactive)
((lambda (head)
(when head
(save-excursion
(goto-char head)
(looking-at org-babel-src-block-regexp))
(push-mark (match-end 5) nil t)
(goto-char (match-beginning 5))))
(org-babel-where-is-src-block-head)))
(defun org-babel-demarcate-block (&optional arg)
"Wrap or split the code in the region or on the point.
When called from inside of a code block the current block is
@ -1122,7 +1170,7 @@ split. When called from outside of a code block a new code block
is created. In both cases if the region is demarcated and if the
region is not active then the point is demarcated."
(interactive "P")
(let ((info (org-babel-get-src-block-info))
(let ((info (org-babel-get-src-block-info 'light))
(stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
(if info
(mapc
@ -1130,7 +1178,7 @@ region is not active then the point is demarcated."
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
(indent (make-string (nth 6 info) ? )))
(indent (make-string (nth 5 info) ? )))
(when (string-match "^[[:space:]]*$"
(buffer-substring (point-at-bol)
(point-at-eol)))
@ -1477,7 +1525,7 @@ parameters when merging lists."
("output" "value")))
(exports-exclusive-groups
'(("code" "results" "both" "none")))
params results exports tangle noweb cache vars var ref shebang comments)
params results exports tangle noweb cache vars shebang comments)
(flet ((e-merge (exclusive-groups &rest result-params)
;; maintain exclusivity of mutually exclusive parameters
(let (output)
@ -1497,63 +1545,60 @@ parameters when merging lists."
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
(concat "^\\([^= \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 results-exclusive-groups
results (split-string (cdr pair)))))
(:file
(when (cdr pair)
(setq results (e-merge results-exclusive-groups
results '("file")))
(unless (or (member "both" exports)
(member "none" exports)
(member "code" exports))
(setq exports (e-merge exports-exclusive-groups
exports '("results"))))
(setq params
(cons pair
(assq-delete-all (car pair) params)))))
(:exports
(setq exports
(e-merge exports-exclusive-groups
exports (split-string (cdr pair)))))
(:tangle ;; take the latest -- always overwrite
(setq tangle (or (list (cdr pair)) tangle)))
(:noweb
(setq noweb
(e-merge '(("yes" "no")) noweb
(split-string (or (cdr pair) "")))))
(:cache
(setq cache
(e-merge '(("yes" "no")) cache
(split-string (or (cdr pair) "")))))
(:shebang ;; take the latest -- always overwrite
(setq shebang (or (list (cdr pair)) shebang)))
(:comments
(setq comments
(e-merge '(("yes" "no")) comments
(split-string (or (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)))
(mapc
(lambda (plist)
(mapc
(lambda (pair)
(case (car pair)
(:var
(let ((name (if (listp (cdr pair))
(cadr pair)
(and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
(cdr pair))
(intern (match-string 1 (cdr pair)))))))
(when name
(setq vars
(cons (cons name pair)
(if (member name (mapcar #'car vars))
(delq nil
(mapcar
(lambda (p) (unless (equal (car p) name) p))
vars))
vars))))))
(:results
(setq results (e-merge results-exclusive-groups
results (split-string (cdr pair)))))
(:file
(when (cdr pair)
(setq results (e-merge results-exclusive-groups
results '("file")))
(unless (or (member "both" exports)
(member "none" exports)
(member "code" exports))
(setq exports (e-merge exports-exclusive-groups
exports '("results"))))
(setq params (cons pair (assq-delete-all (car pair) params)))))
(:exports
(setq exports (e-merge exports-exclusive-groups
exports (split-string (cdr pair)))))
(:tangle ;; take the latest -- always overwrite
(setq tangle (or (list (cdr pair)) tangle)))
(:noweb
(setq noweb (e-merge '(("yes" "no")) noweb
(split-string (or (cdr pair) "")))))
(:cache
(setq cache (e-merge '(("yes" "no")) cache
(split-string (or (cdr pair) "")))))
(:shebang ;; take the latest -- always overwrite
(setq shebang (or (list (cdr pair)) shebang)))
(:comments
(setq comments (e-merge '(("yes" "no")) comments
(split-string (or (cdr pair) "")))))
(t ;; replace: this covers e.g. :session
(setq params (cons pair (assq-delete-all (car pair) params))))))
plist))
plists))
(while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
(cons (cons :comments (mapconcat 'identity comments " "))
(cons (cons :shebang (mapconcat 'identity shebang " "))
(cons (cons :cache (mapconcat 'identity cache " "))
@ -1624,8 +1669,7 @@ block but are passed literally to the \"example-block\"."
#'identity
(split-string
(if evaluate
(let ((raw (org-babel-ref-resolve-reference
source-name nil)))
(let ((raw (org-babel-ref-resolve source-name)))
(if (stringp raw) raw (format "%S" raw)))
(save-restriction
(widen)

27
lisp/org-exp.el
View File

@ -1168,7 +1168,8 @@ on this string to produce the exported version."
(when (plist-get parameters :emph-multiline)
(org-export-concatenate-multiline-emphasis))
;; Remove special table lines
;; Remove special table lines, and store alignment information
(org-store-forced-table-alignment)
(when org-export-table-remove-special-lines
(org-export-remove-special-table-lines))
@ -1773,8 +1774,30 @@ When it is nil, all comments will be removed."
(org-if-unprotected
(replace-match "\\1[[\\2]]")))))))
(defun org-store-forced-table-alignment ()
"Find table lines which force alignment, store the results in properties."
(let (line)
(goto-char (point-min))
(while (re-search-forward "|[ \t]*<[rl][0-9]*>[ \t]*|" nil t)
;; OK, this looks like a table line with an alignment cookie
(org-if-unprotected
(setq line (buffer-substring (point-at-bol) (point-at-eol)))
(when (and (org-at-table-p)
(org-table-cookie-line-p line))
(setq cnt 0 aligns nil)
(mapcar
(lambda (x)
(setq cnt (1+ cnt))
(if (string-match "\\`<\\([lr]\\)" x)
(push (cons cnt (downcase (match-string 1 x))) aligns)))
(org-split-string line "[ \t]*|[ \t]*"))
(add-text-properties (org-table-begin) (org-table-end)
(list 'org-forced-aligns aligns))))
(goto-char (point-at-eol)))))
(defun org-export-remove-special-table-lines ()
"Remove tables lines that are used for internal purposes."
"Remove tables lines that are used for internal purposes.
Also, store forcedalignment information found in such lines."
(goto-char (point-min))
(while (re-search-forward "^[ \t]*|" nil t)
(org-if-unprotected-at (1- (point))

17
lisp/org-html.el
View File

@ -1859,6 +1859,8 @@ lang=\"%s\" xml:lang=\"%s\">
(let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
(label (org-find-text-property-in-string 'org-label (car lines)))
(forced-aligns (org-find-text-property-in-string 'org-forced-aligns
(car lines)))
(attributes (org-find-text-property-in-string 'org-attributes
(car lines)))
(html-table-tag (org-export-splice-attributes
@ -1868,9 +1870,12 @@ lang=\"%s\" xml:lang=\"%s\">
(lambda (x) (string-match "^[ \t]*|-" x))
(cdr lines)))))
(nline 0) fnum nfields i
(nline 0) fnum nfields i (cnt 0)
tbopen line fields html gr colgropen rowstart rowend)
(setq caption (and caption (org-html-do-expand caption)))
(when (and forced-aligns org-table-clean-did-remove-column)
(setq forced-aligns
(mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns)))
(if splice (setq head nil))
(unless splice (push (if head "<thead>" "<tbody>") html))
(setq tbopen t)
@ -1923,17 +1928,21 @@ lang=\"%s\" xml:lang=\"%s\">
(unless (car org-table-colgroup-info)
(setq org-table-colgroup-info
(cons :start (cdr org-table-colgroup-info))))
(setq i 0)
(push (mapconcat
(lambda (x)
(setq gr (pop org-table-colgroup-info))
(setq gr (pop org-table-colgroup-info)
i (1+ i))
(format "%s<col align=\"%s\" />%s"
(if (memq gr '(:start :startend))
(prog1
(if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
(setq colgropen t))
"")
(if (> (/ (float x) nline) org-table-number-fraction)
"right" "left")
(if (assoc i forced-aligns)
(cdr (assoc (cdr (assoc i forced-aligns)) '(("l" . "left") ("r" . "right"))))
(if (> (/ (float x) nline) org-table-number-fraction)
"right" "left"))
(if (memq gr '(:end :startend))
(progn (setq colgropen nil) "</colgroup>")
"")))

8
lisp/org-inlinetask.el
View File

@ -106,7 +106,7 @@ When nil, they will not be exported."
(defvar org-complex-heading-regexp)
(defvar org-property-end-re)
(defcustom org-inlinetask-defaut-state nil
(defcustom org-inlinetask-default-state nil
"Non-nil means make inline tasks have a TODO keyword initially.
This should be the state `org-inlinetask-insert-task' should use by
default, or nil of no state should be assigned."
@ -117,16 +117,16 @@ default, or nil of no state should be assigned."
(defun org-inlinetask-insert-task (&optional no-state)
"Insert an inline task.
If prefix arg NO-STATE is set, ignore `org-inlinetask-defaut-state'."
If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
(interactive "P")
(or (bolp) (newline))
(let ((indent org-inlinetask-min-level))
(if org-odd-levels-only
(setq indent (- (* 2 indent) 1)))
(insert (make-string indent ?*)
(if (or no-state (not org-inlinetask-defaut-state))
(if (or no-state (not org-inlinetask-default-state))
" \n"
(concat " " org-inlinetask-defaut-state " \n"))
(concat " " org-inlinetask-default-state " \n"))
(make-string indent ?*) " END\n"))
(end-of-line -1))
(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)

2
lisp/org-src.el
View File

@ -214,7 +214,7 @@ buffer."
(let ((mark (and (org-region-active-p) (mark)))
(case-fold-search t)
(info (org-edit-src-find-region-and-lang))
(babel-info (org-babel-get-src-block-info))
(babel-info (org-babel-get-src-block-info 'light))
(org-mode-p (eq major-mode 'org-mode))
(beg (make-marker))
(end (make-marker))

13
lisp/org-table.el
View File

@ -345,14 +345,19 @@ available parameters."
(save-match-data
(and (string-match "[<>]\\|&[lg]t;" line)
(or (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" line)
(or (string-match
"\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" line)
(string-match "\\(\\`[ \t<>lr0-9|gt&;]+\\'\\)" line))
(not (delq nil (mapcar
(lambda (s)
(not (or (equal s "")
(string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s)
(string-match "\\`&lt;\\([lr]?[0-9]+\\|[lr]\\)&gt;\\'" s))))
(org-split-string (match-string 1 line) "[ \t]*|[ \t]*")))))))
(string-match
"\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s)
(string-match
"\\`&lt;\\([lr]?[0-9]+\\|[lr]\\)&gt;\\'"
s))))
(org-split-string (match-string 1 line)
"[ \t]*|[ \t]*")))))))
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")

2
lisp/org-taskjuggler.el
View File

@ -503,7 +503,7 @@ finally add more underscore characters (\"_\")."
(parts (split-string headline))
(id (org-taskjuggler-clean-id (downcase (pop parts)))))
; try to add more parts of the headline to make it unique
(while (member id unique-ids)
(while (and (member id unique-ids) (car parts))
(setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
; if its still not unique add "_"
(while (member id unique-ids)

93
testing/examples/babel.org
View File

@ -41,7 +41,6 @@
#+results:
: 4
* excessive id links on tangling
:PROPERTIES:
:ID: ef06fd7f-012b-4fde-87a2-2ae91504ea7e
@ -59,3 +58,95 @@
#+begin_src emacs-lisp :tangle no
(message "for tangling")
#+end_src
* simple variable resolution
:PROPERTIES:
:ID: f68821bc-7f49-4389-85b5-914791ee3718
:END:
#+source: four
#+begin_src emacs-lisp
(list 1 2 3 4)
#+end_src
#+begin_src emacs-lisp :var four=four
(length four)
#+end_src
#+results:
: 4
* multi-line header arguments
:PROPERTIES:
:ID: b77c8857-6c76-4ea9-8a61-ddc2648d96c4
:END:
#+headers: :var letters='(a b c d e f g)
#+begin_src emacs-lisp :var numbers='(1 2 3 4 5 6 7)
(map 'list #'list numbers letters)
#+end_src
#+results:
| 1 | a |
| 2 | b |
| 3 | c |
| 4 | d |
| 5 | e |
| 6 | f |
| 7 | g |
* simple named code block
:PROPERTIES:
:ID: 0d82b52d-1bb9-4916-816b-2c67c8108dbb
:END:
#+source: i-have-a-name
#+begin_src emacs-lisp
42
#+end_src
#+results:
: 42
#+results: i-have-a-name
: 42
* Pascal's Triangle -- export test
:PROPERTIES:
:ID: 92518f2a-a46a-4205-a3ab-bcce1008a4bb
:END:
#+source: pascals-triangle
#+begin_src emacs-lisp :var n=5 :exports both
(defun pascals-triangle (n)
(if (= n 0)
(list (list 1))
(let* ((prev-triangle (pascals-triangle (- n 1)))
(prev-row (car (reverse prev-triangle))))
(append prev-triangle
(list (map 'list #'+
(append prev-row '(0))
(append '(0) prev-row)))))))
(pascals-triangle n)
#+end_src
* calling code blocks from inside table
:PROPERTIES:
:ID: 6d2ff4ce-4489-4e2a-9c65-e3f71f77d975
:END:
#+source: take-sqrt
#+begin_src emacs-lisp :var n=9
(sqrt n)
#+end_src
* executing an lob call line
:PROPERTIES:
:results: silent
:END:
69fbe856-ca9c-4f20-9146-826d2f488c1d
#+call: echo(input="testing")
#+call: echo(input="testing") :results vector
#+call: echo() :var input="testing"
#+call: echo() :var input="testing" :results vector

2
testing/jump

@ -1 +1 @@
Subproject commit 0def5442723f8a2928eda7bcf428aa29f8aa97c1
Subproject commit 820bb7d81bf08cee6f2610965ca97e96a1fe561d

11
testing/lisp/test-ob-exp.el
View File

@ -84,6 +84,17 @@
(should-not (exp-p "no"))
(should-not (exp-p "tangle")))))
(ert-deftest ob-exp/exports-both ()
"Test the :exports both header argument.
The code block should create both <pre></pre> and <table></table>
elements in the final html."
(let (html)
(org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
(org-narrow-to-subtree)
(setq html (org-export-as-html nil nil nil 'string))
(should (string-match "<pre.*>[^\000]*</pre>" html))
(should (string-match "<table.*>[^\000]*</table>" html)))))
(provide 'test-ob-exp)
;;; test-ob-exp.el ends here

50
testing/lisp/test-ob-lob.el Normal file
View File

@ -0,0 +1,50 @@
;;; test-ob-lob.el
;; Copyright (c) 2010 Eric Schulte
;; Authors: Eric Schulte
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Template test file for Org-mode tests
;;; Code:
(let ((load-path (cons (expand-file-name
".." (file-name-directory
(or load-file-name buffer-file-name)))
load-path)))
(require 'org-test)
(require 'org-test-ob-consts))
;;; Tests
(ert-deftest test-ob-lob/ingest ()
"Test the ingestion of an org-mode file."
(should (< 0 (org-babel-lob-ingest
(expand-file-name "babel.org" org-test-example-dir)))))
(ert-deftest test-ob-lob/call-with-header-arguments ()
"Test the evaluation of a library of babel #+call: line."
(org-test-at-marker
(expand-file-name "babel.org" org-test-example-dir)
"69fbe856-ca9c-4f20-9146-826d2f488c1d"
(move-beginning-of-line 1)
(forward-line 1)
(should (string= "testing" (org-babel-lob-execute
(org-babel-lob-get-info))))
(forward-line 1)
(should (string= "testing" (caar (org-babel-lob-execute
(org-babel-lob-get-info)))))
(forward-line 1)
(should (string= "testing" (org-babel-lob-execute
(org-babel-lob-get-info))))
(forward-line 1)
(should (string= "testing" (caar (org-babel-lob-execute
(org-babel-lob-get-info)))))))
(provide 'test-ob-lob)
;;; test-ob-lob.el ends here

4
testing/lisp/test-ob-sh.el
View File

@ -25,9 +25,9 @@
"Expanded shell bodies should not start with a blank line
unless the body of the tangled block does."
(should-not (string-match "^[\n\r][\t ]*[\n\r]"
(org-babel-expand-body:sh "echo 2" '())))
(org-babel-expand-body:generic "echo 2" '())))
(should (string-match "^[\n\r][\t ]*[\n\r]"
(org-babel-expand-body:sh "\n\necho 2" '()))))
(org-babel-expand-body:generic "\n\necho 2" '()))))
(ert-deftest test-ob-sh/dont-error-on-empty-results ()
"Was throwing an elisp error when shell blocks threw errors and

31
testing/lisp/test-ob-table.el Normal file
View File

@ -0,0 +1,31 @@
;;; test-ob-table.el
;; Copyright (c) ߚ Eric Schulte
;; Authors: Eric Schulte
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;;; Comments:
;; Template test file for Org-mode tests
;;; Code:
(let ((load-path (cons (expand-file-name
".." (file-name-directory
(or load-file-name buffer-file-name)))
load-path)))
(require 'org-test)
(require 'org-test-ob-consts))
;;; Tests
(ert-deftest test-ob-table/sbe ()
"Test that `sbe' can be used to call code blocks from inside tables."
(org-test-at-id "6d2ff4ce-4489-4e2a-9c65-e3f71f77d975"
(should (= 2 (sbe take-sqrt (n "4"))))))
(provide 'test-ob-table)
;;; test-ob-table.el ends here

36
testing/lisp/test-ob.el
View File

@ -20,30 +20,56 @@
(require 'org-test-ob-consts))
;;; ob-get-src-block-info
(ert-deftest test-org-babel-get-src-block-info-language ()
(ert-deftest test-org-babel/get-src-block-info-language ()
(org-test-at-marker nil org-test-file-ob-anchor
(let ((info (org-babel-get-src-block-info)))
(should (string= "emacs-lisp" (nth 0 info))))))
(ert-deftest test-org-babel-get-src-block-info-body ()
(ert-deftest test-org-babel/get-src-block-info-body ()
(org-test-at-marker nil org-test-file-ob-anchor
(let ((info (org-babel-get-src-block-info)))
(should (string-match (regexp-quote org-test-file-ob-anchor)
(nth 1 info))))))
(ert-deftest test-org-babel-get-src-block-info-tangle ()
(ert-deftest test-org-babel/get-src-block-info-tangle ()
(org-test-at-marker nil org-test-file-ob-anchor
(let ((info (org-babel-get-src-block-info)))
(should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
;;; elisp forms in header arguments
(ert-deftest test-org-babel-elisp-in-header-arguments ()
(ert-deftest test-org-babel/elisp-in-header-arguments ()
"Test execution of elisp forms in header arguments."
;; at the babel.org:elisp-forms-in-header-arguments header
(org-test-at-id "22d67284-bf14-4cdc-8319-f4bd876829d7"
(org-babel-next-src-block)
(let ((info (org-babel-get-src-block-info)))
(should (= 4 (org-babel-execute-src-block))))))
(ert-deftest test-org-babel/simple-named-code-block ()
"Test that simple named code blocks can be evaluated."
(org-test-at-id "0d82b52d-1bb9-4916-816b-2c67c8108dbb"
(org-babel-next-src-block 1)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest test-org-babel/simple-variable-resolution ()
"Test that simple variable resolution is working."
(org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
(org-babel-next-src-block 2)
(should (= 4 (org-babel-execute-src-block)))))
(ert-deftest test-org-babel/multi-line-header-arguments ()
"Test that multi-line header arguments and can be read."
(org-test-at-id "b77c8857-6c76-4ea9-8a61-ddc2648d96c4"
(org-babel-next-src-block)
(let ((results (org-babel-execute-src-block)))
(should (equal 'a (cadr (assoc 1 results))))
(should (equal 'd (cadr (assoc 4 results)))))))
(ert-deftest test-org-babel/sha1-hash ()
(org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
(org-babel-next-src-block 2)
(should (string= "7374bf4f8a18dfcb6f365f93d15f1a0ef42db745"
(org-babel-sha1-hash)))))
(provide 'test-ob)
;;; test-ob ends here

21
testing/org-test.el
View File

@ -133,15 +133,15 @@ files."
;;; Navigation Functions
(defjump 'org-test-jump
'(("lisp/\\1.el" . "testing/lisp/test-\\1.el")
("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
("testing/lisp/test-\\1.el" . "lisp/\\1.el")
("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
(defjump org-test-jump
(("lisp/\\1.el" . "testing/lisp/test-\\1.el")
("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
("testing/lisp/test-\\1.el" . "lisp/\\1.el")
("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
(concat org-base-dir "/")
"Jump between org-mode files and their tests."
(lambda (path)
@ -151,7 +151,8 @@ files."
(find-file full-path)
(insert
";;; " file-name "\n\n"
";; Copyright (c) 2010 " user-full-name "\n"
";; Copyright (c) " (nth 5 (decode-time (current-time)))
" " user-full-name "\n"
";; Authors: " user-full-name "\n\n"
";; Released under the GNU General Public License version 3\n"
";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"