diff options
| author | Carsten Dominik <carsten.dominik@gmail.com> | 2010-10-21 16:28:52 +0200 |
|---|---|---|
| committer | Carsten Dominik <carsten.dominik@gmail.com> | 2010-10-21 16:28:52 +0200 |
| commit | 5591fb2cdeff1caa8674beea8bdf0f66533e9b63 (patch) | |
| tree | b6843e0efa864f794a809293443b25a82890f52b | |
| parent | 7712d78ab4f37e238d3c85c8eedf889954fdae25 (diff) | |
| parent | 3852a905b853b5869cfc725ab691a029b8cfd5c4 (diff) | |
| download | org-mode-5591fb2cdeff1caa8674beea8bdf0f66533e9b63.tar.gz | |
Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode
44 files changed, 979 insertions, 754 deletions
diff --git a/ORGWEBPAGE/Changes.org b/ORGWEBPAGE/Changes.org index 2abe8f8..9443c11 100644 --- a/ORGWEBPAGE/Changes.org +++ b/ORGWEBPAGE/Changes.org @@ -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 diff --git a/lisp/ob-C.el b/lisp/ob-C.el index 0156e5d..6dd1a4f 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -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." diff --git a/lisp/ob-R.el b/lisp/ob-R.el index ea4df18..a2b9925 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -51,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 @@ -73,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) @@ -133,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) diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el index 5b3141c..b0d64b4 100644 --- a/lisp/ob-asymptote.el +++ b/lisp/ob-asymptote.el @@ -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 diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index 43a069c..7ee9499 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -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) diff --git a/lisp/ob-css.el b/lisp/ob-css.el index bfd950e..ef96610 100644 --- a/lisp/ob-css.el +++ b/lisp/ob-css.el @@ -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'." diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index 48917d9..1a8a8e0 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -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. diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el index 68ddf14..9a2265e 100644 --- a/lisp/ob-dot.el +++ b/lisp/ob-dot.el @@ -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) diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el index efa5a67..b9e9830 100644 --- a/lisp/ob-emacs-lisp.el +++ b/lisp/ob-emacs-lisp.el @@ -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) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 3004c4a..e7269ef 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -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) diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index cfe80d8..d530f8b 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -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. diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index bab6f11..f70198e 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -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 diff --git a/lisp/ob-js.el b/lisp/ob-js.el index 661cd34..25652f0 100644 --- a/lisp/ob-js.el +++ b/lisp/ob-js.el @@ -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." diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el index c27d7fd..bab110f 100644 --- a/lisp/ob-keys.el +++ b/lisp/ob-keys.el @@ -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 diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index f996049..ca092f6 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -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) diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 2036fb4..6e88996 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -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 diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index e88bd87..3560a18 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -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))))) diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el index c247dcb..500ff96 100644 --- a/lisp/ob-mscgen.el +++ b/lisp/ob-mscgen.el @@ -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'. diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el index 57c7140..d5e79f4 100644 --- a/lisp/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -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) diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el index 59f6819..e2f12d2 100644 --- a/lisp/ob-octave.el +++ b/lisp/ob-octave.el @@ -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) diff --git a/lisp/ob-org.el b/lisp/ob-org.el index 8b45de8..6cd0855 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -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'." diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el index 96443fe..ae5fc89 100644 --- a/lisp/ob-perl.el +++ b/lisp/ob-perl.el @@ -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) diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index bd29de0..fcc54dd 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -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 diff --git a/lisp/ob-python.el b/lisp/ob-python.el index c056cb6..a99b6fe 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -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 diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index e96bf3b..b27dda9 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -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)) diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index 2d966b8..7f56104 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -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 diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el index 196597a..8a51df0 100644 --- a/lisp/ob-sass.el +++ b/lisp/ob-sass.el @@ -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) diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index ce6be0b..6c5fbdb 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -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))))) diff --git a/lisp/ob-screen.el b/lisp/ob-screen.el index 8290aa6..a07db7a 100644 --- a/lisp/ob-screen.el +++ b/lisp/ob-screen.el @@ -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 ")"))) diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index 20dde69..107d1c4 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -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) diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index ccaae58..98f4183 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -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) diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el index e53d074..d5ad7d3 100644 --- a/lisp/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -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) diff --git a/lisp/ob-table.el b/lisp/ob-table.el index 4a0454c..1a80f18 100644 --- a/lisp/ob-table.el +++ b/lisp/ob-table.el @@ -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) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index eb37600..9f069fc 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -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 @@ -68,9 +68,7 @@ (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)) @@ -111,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.") @@ -138,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. @@ -250,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.") @@ -326,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 @@ -357,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)) @@ -371,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))) @@ -383,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) @@ -401,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 " ]*")))) @@ -452,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) @@ -480,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. @@ -578,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." @@ -717,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. @@ -752,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)) @@ -765,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) @@ -869,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) @@ -1054,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))) @@ -1116,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 @@ -1123,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 @@ -1131,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))) @@ -1478,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) @@ -1498,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 " ")) @@ -1625,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) diff --git a/lisp/org-src.el b/lisp/org-src.el index 1e5894f..e959883 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -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)) diff --git a/testing/examples/babel.org b/testing/examples/babel.org index 8294e3f..e367aea 100644 --- a/testing/examples/babel.org +++ b/testing/examples/babel.org @@ -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 diff --git a/testing/jump b/testing/jump -Subproject 0def5442723f8a2928eda7bcf428aa29f8aa97c +Subproject 820bb7d81bf08cee6f2610965ca97e96a1fe561 diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el index 471453f..1c2214c 100644 --- a/testing/lisp/test-ob-exp.el +++ b/testing/lisp/test-ob-exp.el @@ -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 diff --git a/testing/lisp/test-ob-lob.el b/testing/lisp/test-ob-lob.el new file mode 100644 index 0000000..5d3dddd --- /dev/null +++ b/testing/lisp/test-ob-lob.el @@ -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 diff --git a/testing/lisp/test-ob-sh.el b/testing/lisp/test-ob-sh.el index 929bac5..d463894 100644 --- a/testing/lisp/test-ob-sh.el +++ b/testing/lisp/test-ob-sh.el @@ -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 diff --git a/testing/lisp/test-ob-table.el b/testing/lisp/test-ob-table.el new file mode 100644 index 0000000..bada2b8 --- /dev/null +++ b/testing/lisp/test-ob-table.el @@ -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 diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 69859f3..f937c99 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -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
\ No newline at end of file diff --git a/testing/org-test.el b/testing/org-test.el index 970ab98..3535c8b 100644 --- a/testing/org-test.el +++ b/testing/org-test.el @@ -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" |