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

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

This commit is contained in:
Carsten Dominik 2010-04-24 00:24:34 +02:00
parent 0483c0b595 c12e18b6cf
commit 39f124ed0d
27 changed files with 720 additions and 346 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
contrib/babel/lisp/langs/org-babel-C.el
View File

@ -58,11 +58,21 @@
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
(let ((c-variant 'cpp)) (org-babel-C-execute body params))) (let ((c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c++ (body params &optional processed-params)
"Expand a block of C++ code with org-babel according to it's
header arguments (calls `org-babel-C-expand')."
(let ((c-variant 'cpp)) (org-babel-C-expand body params processed-params)))
(defun org-babel-execute:C (body params) (defun org-babel-execute:C (body params)
"Execute a block of C code with org-babel. This function is "Execute a block of C code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
(let ((c-variant 'c)) (org-babel-C-execute body params))) (let ((c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c (body params &optional processed-params)
"Expand a block of C code with org-babel according to it's
header arguments (calls `org-babel-C-expand')."
(let ((c-variant 'c)) (org-babel-C-expand body params processed-params)))
(defun org-babel-C-execute (body params) (defun org-babel-C-execute (body params)
"This should only be called by `org-babel-execute:C' or "This should only be called by `org-babel-execute:C' or
`org-babel-execute:c++'." `org-babel-execute:c++'."
@ -76,29 +86,7 @@ called by `org-babel-execute-src-block'."
(tmp-out-file (make-temp-file "org-babel-C-out")) (tmp-out-file (make-temp-file "org-babel-C-out"))
(cmdline (cdr (assoc :cmdline params))) (cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params))) (flags (cdr (assoc :flags params)))
(vars (second processed-params)) (full-body (org-babel-C-expand body params))
(main-p (not (string= (cdr (assoc :main params)) "no")))
(includes (or (cdr (assoc :includes params))
(org-entry-get nil "includes" t)))
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-entry-get nil "defines" t))))
(full-body (mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
(if (listp includes) includes (list includes)) "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
;; body
"\n" (if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n"))
(error-buf (get-buffer-create "*Org-Babel Error Output*")) (error-buf (get-buffer-create "*Org-Babel Error Output*"))
(compile (compile
(progn (progn
@ -116,6 +104,7 @@ called by `org-babel-execute-src-block'."
tmp-src-file) tmp-src-file)
(current-buffer) 'replace error-buf))))) (current-buffer) 'replace error-buf)))))
(if (= compile 0) (if (= compile 0)
(org-babel-reassemble-table
(org-babel-read (org-babel-read
(org-babel-trim (org-babel-trim
(with-temp-buffer (with-temp-buffer
@ -124,6 +113,8 @@ called by `org-babel-execute-src-block'."
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) (concat tmp-bin-file (if cmdline (concat " " cmdline) ""))
(current-buffer) 'replace) (current-buffer) 'replace)
(buffer-string)))) (buffer-string))))
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))
(progn (progn
(with-current-buffer error-buf (with-current-buffer error-buf
(goto-char (point-max)) (goto-char (point-max))
@ -131,6 +122,34 @@ called by `org-babel-execute-src-block'."
(goto-char (point-min))) (goto-char (point-min)))
(display-buffer error-buf) nil)))) (display-buffer error-buf) nil))))
(defun org-babel-C-expand (body params &optional processed-params)
"Expand a block of C or C++ code with org-babel according to
it's header arguments."
(let ((vars (second (or processed-params
(org-babel-process-params params))))
(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))))))
(mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
(if (listp includes) includes (list includes)) "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body) (defun org-babel-C-ensure-main-wrap (body)
"Wrap body in a \"main\" function call if none exists." "Wrap body in a \"main\" function call if none exists."
(if (string-match "^[ \t]*[intvod]+[ \t]*main[ \t]*(.*)" body) (if (string-match "^[ \t]*[intvod]+[ \t]*main[ \t]*(.*)" body)

56
contrib/babel/lisp/langs/org-babel-R.el
View File

@ -35,6 +35,26 @@
(add-to-list 'org-babel-tangle-langs '("R" "R" "#!/usr/bin/env Rscript")) (add-to-list 'org-babel-tangle-langs '("R" "R" "#!/usr/bin/env Rscript"))
(defun org-babel-expand-body:R (body params &optional processed-params)
(let* ((processed-params (or processed-params
(org-babel-process-params params)))
(vars (mapcar (lambda (i) (cons (car (nth i (second processed-params)))
(org-babel-reassemble-table
(cdr (nth i (second processed-params)))
(cdr (nth i (fifth processed-params)))
(cdr (nth i (sixth processed-params))))))
(number-sequence 0 (1- (length (second processed-params))))))
(out-file (cdr (assoc :file params))))
(concat
(if out-file (concat (org-babel-R-construct-graphics-device-call out-file params) "\n") "")
(mapconcat ;; define any variables
(lambda (pair)
(org-babel-R-assign-elisp (car pair) (cdr pair)
(equal "yes" (cdr (assoc :colnames params)))
(equal "yes" (cdr (assoc :rownames params)))))
vars "\n")
"\n" body "\n" (if out-file "dev.off()\n" ""))))
(defun org-babel-execute:R (body params) (defun org-babel-execute:R (body params)
"Execute a block of R code with org-babel. This function is "Execute a block of R code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
@ -43,17 +63,11 @@ called by `org-babel-execute-src-block'."
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(result-type (fourth processed-params)) (result-type (fourth processed-params))
(session (org-babel-R-initiate-session (first processed-params) params)) (session (org-babel-R-initiate-session (first processed-params) params))
(vars (second processed-params)) (colnames-p (equal "yes" (cdr (assoc :colnames params))))
(column-names-p (and (cdr (assoc :colnames params)) (rownames-p (equal "yes" (cdr (assoc :rownames params))))
(string= "yes" (cdr (assoc :colnames params)))))
(out-file (cdr (assoc :file params))) (out-file (cdr (assoc :file params)))
(augmented-body (full-body (org-babel-expand-body:R body params processed-params))
(concat (result (org-babel-R-evaluate session full-body result-type colnames-p rownames-p)))
(if out-file (concat (org-babel-R-construct-graphics-device-call out-file params) "\n") "")
(mapconcat ;; define any variables
(lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair))) vars "\n")
"\n" body "\n" (if out-file "dev.off()\n" "")))
(result (org-babel-R-evaluate session augmented-body result-type column-names-p)))
(or out-file result)))) (or out-file result))))
(defun org-babel-prep-session:R (session params) (defun org-babel-prep-session:R (session params)
@ -62,7 +76,11 @@ called by `org-babel-execute-src-block'."
(vars (org-babel-ref-variables params)) (vars (org-babel-ref-variables params))
(var-lines (var-lines
(mapcar (mapcar
(lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair))) vars))) (lambda (pair) (org-babel-R-assign-elisp
(car pair) (cdr pair)
(equal (cdr (assoc :colnames params)) "yes")
(equal (cdr (assoc :rownames params)) "yes")))
vars)))
(org-babel-comint-in-buffer session (org-babel-comint-in-buffer session
(mapc (lambda (var) (mapc (lambda (var)
(move-end-of-line 1) (insert var) (comint-send-input nil t) (move-end-of-line 1) (insert var) (comint-send-input nil t)
@ -86,7 +104,7 @@ called by `org-babel-execute-src-block'."
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
(format "%S" s))) (format "%S" s)))
(defun org-babel-R-assign-elisp (name value) (defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
"Construct R code assigning the elisp VALUE to a variable named NAME." "Construct R code assigning the elisp VALUE to a variable named NAME."
(if (listp value) (if (listp value)
(let ((transition-file (make-temp-file "org-babel-R-import"))) (let ((transition-file (make-temp-file "org-babel-R-import")))
@ -95,8 +113,10 @@ called by `org-babel-execute-src-block'."
(with-temp-file (org-babel-maybe-remote-file transition-file) (with-temp-file (org-babel-maybe-remote-file transition-file)
(insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))) (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
(insert "\n")) (insert "\n"))
(format "%s <- read.table(\"%s\", header=%s, sep=\"\\t\", as.is=TRUE)" (format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)"
name transition-file (if (eq (second value) 'hline) "TRUE" "FALSE"))) name transition-file
(if (and (eq (second value) 'hline) colnames-p) "TRUE" "FALSE")
(if rownames-p "1" "NULL")))
(format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) (format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
(defun org-babel-R-initiate-session (session params) (defun org-babel-R-initiate-session (session params)
@ -140,9 +160,9 @@ called by `org-babel-execute-src-block'."
(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") (defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") (defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
(defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n} (defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n}
write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=%s, quote=FALSE)") write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)")
(defun org-babel-R-evaluate (session body result-type column-names-p) (defun org-babel-R-evaluate (session body result-type column-names-p row-names-p)
"Pass BODY to the R process in SESSION. If RESULT-TYPE equals "Pass BODY to the R process in SESSION. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in 'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the BODY, if RESULT-TYPE equals 'value then return the value of the
@ -160,7 +180,7 @@ last statement in BODY, as elisp."
(stderr (stderr
(with-temp-buffer (with-temp-buffer
(insert (format org-babel-R-wrapper-method (insert (format org-babel-R-wrapper-method
body tmp-file (if column-names-p "TRUE" "FALSE"))) body tmp-file (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") "FALSE")))
(setq exit-code (org-babel-shell-command-on-region (setq exit-code (org-babel-shell-command-on-region
(point-min) (point-max) "R --no-save" nil 'replace (current-buffer))) (point-min) (point-max) "R --no-save" nil 'replace (current-buffer)))
(buffer-string)))) (buffer-string))))
@ -175,7 +195,7 @@ last statement in BODY, as elisp."
(case result-type (case result-type
(value (value
(mapconcat #'org-babel-chomp (list body (mapconcat #'org-babel-chomp (list body
(format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=%s, quote=FALSE)" tmp-file (if column-names-p "TRUE" "FALSE")) (format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)" tmp-file (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") "FALSE"))
org-babel-R-eoe-indicator) "\n")) org-babel-R-eoe-indicator) "\n"))
(output (output
(mapconcat #'org-babel-chomp (list body org-babel-R-eoe-indicator) "\n")))) (mapconcat #'org-babel-chomp (list body org-babel-R-eoe-indicator) "\n"))))

2
contrib/babel/lisp/langs/org-babel-asymptote.el
View File

@ -56,6 +56,8 @@
(defvar org-babel-default-header-args:asymptote '((:results . "file") (:exports . "results")) (defvar org-babel-default-header-args:asymptote '((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a asymptote source block.") "Default arguments to use when evaluating a asymptote source block.")
(defun org-babel-expand-body:asymptote (body params &optional processed-params) body)
(defun org-babel-execute:asymptote (body params) (defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code with org-babel. This function is "Execute a block of Asymptote code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."

12
contrib/babel/lisp/langs/org-babel-clojure.el
View File

@ -263,12 +263,18 @@ last statement in BODY, as elisp."
(org-babel-clojure-evaluate-session buffer body result-type) (org-babel-clojure-evaluate-session buffer body result-type)
(org-babel-clojure-evaluate-external-process 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)
(org-babel-clojure-build-full-form
body (second (or processed-params (org-babel-process-params params)))))
(defun org-babel-execute:clojure (body params) (defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with org-babel." "Execute a block of Clojure code with org-babel."
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(vars (second processed-params)) (body (org-babel-expand-body:clojure body params processed-params))
(body (org-babel-clojure-build-full-form body vars))
(session (org-babel-clojure-initiate-session (first processed-params)))) (session (org-babel-clojure-initiate-session (first processed-params))))
(org-babel-clojure-evaluate session body (fourth processed-params)))) (org-babel-reassemble-table
(org-babel-clojure-evaluate session body (fourth 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))))))
(provide 'org-babel-clojure) (provide 'org-babel-clojure)

2
contrib/babel/lisp/langs/org-babel-css.el
View File

@ -36,6 +36,8 @@
(add-to-list 'org-babel-tangle-langs '("css" "css" nil t)) (add-to-list 'org-babel-tangle-langs '("css" "css" nil t))
(defun org-babel-expand-body:css (body params &optional processed-params) body)
(defun org-babel-execute:css (body params) (defun org-babel-execute:css (body params)
"Execute a block of CSS code with org-babel. This function is "Execute a block of CSS code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."

2
contrib/babel/lisp/langs/org-babel-ditaa.el
View File

@ -49,6 +49,8 @@
'((:results . "file") (:exports . "results")) '((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a ditaa source block.") "Default arguments to use when evaluating a ditaa source block.")
(defun org-babel-expand-body:ditaa (body params &optional processed-params) body)
(defun org-babel-execute:ditaa (body params) (defun org-babel-execute:ditaa (body params)
"Execute a block of Ditaa code with org-babel. This function is "Execute a block of Ditaa code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."

2
contrib/babel/lisp/langs/org-babel-dot.el
View File

@ -50,6 +50,8 @@
(defvar org-babel-default-header-args:dot '((:results . "file") (:exports . "results")) (defvar org-babel-default-header-args:dot '((:results . "file") (:exports . "results"))
"Default arguments to use when evaluating a dot source block.") "Default arguments to use when evaluating a dot source block.")
(defun org-babel-expand-body:dot (body params &optional processed-params) body)
(defun org-babel-execute:dot (body params) (defun org-babel-execute:dot (body params)
"Execute a block of Dot code with org-babel. This function is "Execute a block of Dot code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."

36
contrib/babel/lisp/langs/org-babel-emacs-lisp.el
View File

@ -35,21 +35,35 @@
(add-to-list 'org-babel-tangle-langs '("emacs-lisp" "el")) (add-to-list 'org-babel-tangle-langs '("emacs-lisp" "el"))
(defvar org-babel-default-header-args:emacs-lisp
'((:hlines . "yes") (:colnames . "no"))
"Default arguments to use when evaluating an emacs-lisp source block.")
(defun org-babel-expand-body:emacs-lisp (body params &optional processed-params)
(let* ((processed-params (or processed-params (org-babel-process-params params)))
(vars (second processed-params))
(processed-params (org-babel-process-params params))
(result-params (third processed-params))
(print-level nil) (print-length nil)
(body (concat "(let ("
(mapconcat
(lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
vars "\n ")
")\n"
(if (or (member "code" result-params)
(member "pp" result-params))
(concat "(pp " body ")") body) ")")))
body))
(defun org-babel-execute:emacs-lisp (body params) (defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with org-babel." "Execute a block of emacs-lisp code with org-babel."
(message "executing emacs-lisp code block...") (message "executing emacs-lisp code block...")
(save-window-excursion (save-window-excursion
(let* ((processed-params (org-babel-process-params params)) (let ((processed-params (org-babel-process-params params)))
(result-params (third processed-params)) (org-babel-reassemble-table
(vars (second processed-params)) (eval (read (org-babel-expand-body:emacs-lisp body params)))
(print-level nil) (print-length nil)) (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
vars)
,(read (concat "(progn "
(if (or (member "code" result-params)
(member "pp" result-params))
(concat "(pp " body ")") body)
")")))))))
(provide 'org-babel-emacs-lisp) (provide 'org-babel-emacs-lisp)
;;; org-babel-emacs-lisp.el ends here ;;; org-babel-emacs-lisp.el ends here

22
contrib/babel/lisp/langs/org-babel-gnuplot.el
View File

@ -68,13 +68,9 @@ variable names and the value to be used in the gnuplot code."
(cdr pair)))) (cdr pair))))
(org-babel-ref-variables params))) (org-babel-ref-variables params)))
(defun org-babel-execute:gnuplot (body params) (defun org-babel-expand-body:gnuplot (body params &optional processed-params)
"Execute a block of Gnuplot code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Gnuplot source code block")
(save-window-excursion (save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params)) (let* ((vars (org-babel-gnuplot-process-vars params))
(session (cdr (assoc :session params)))
(out-file (cdr (assoc :file params))) (out-file (cdr (assoc :file params)))
(term (or (cdr (assoc :term params)) (term (or (cdr (assoc :term params))
(when out-file (file-name-extension out-file)))) (when out-file (file-name-extension out-file))))
@ -87,7 +83,6 @@ called by `org-babel-execute-src-block'."
(timefmt (plist-get params :timefmt)) (timefmt (plist-get params :timefmt))
(time-ind (or (plist-get params :timeind) (time-ind (or (plist-get params :timeind)
(when timefmt 1))) (when timefmt 1)))
(result-type (cdr (assoc :results params)))
output) output)
(flet ((add-to-body (text) (flet ((add-to-body (text)
(setq body (concat text "\n" body)))) (setq body (concat text "\n" body))))
@ -126,7 +121,18 @@ called by `org-babel-execute-src-block'."
(mapc (lambda (pair) (mapc (lambda (pair)
(setq body (replace-regexp-in-string (setq body (replace-regexp-in-string
(format "\\$%s" (car pair)) (cdr pair) body))) (format "\\$%s" (car pair)) (cdr pair) body)))
vars) vars))
body)))
(defun org-babel-execute:gnuplot (body params)
"Execute a block of Gnuplot code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Gnuplot source code block")
(let ((session (cdr (assoc :session params)))
(result-type (cdr (assoc :results params)))
(out-file (cdr (assoc :file params)))
(body (org-babel-expand-body:gnuplot body params)))
(save-window-excursion
;; evaluate the code body with gnuplot ;; evaluate the code body with gnuplot
(if (string= session "none") (if (string= session "none")
(let ((script-file (make-temp-file "org-babel-gnuplot-script"))) (let ((script-file (make-temp-file "org-babel-gnuplot-script")))
@ -142,7 +148,7 @@ called by `org-babel-execute-src-block'."
(gnuplot-send-buffer-to-gnuplot))) (gnuplot-send-buffer-to-gnuplot)))
(if (member "output" (split-string result-type)) (if (member "output" (split-string result-type))
output output
out-file))))) out-file))))
(defun org-babel-prep-session:gnuplot (session params) (defun org-babel-prep-session:gnuplot (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

17
contrib/babel/lisp/langs/org-babel-haskell.el
View File

@ -54,6 +54,13 @@
(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") (defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"")
(defun org-babel-expand-body:haskell (body params &optional processed-params)
(let (vars (second (or processed-params (org-babel-process-params params))))
(concat
(mapconcat
(lambda (pair) (format "let %s = %s;" (car pair) (cdr pair)))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:haskell (body params) (defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code with org-babel." "Execute a block of Haskell code with org-babel."
(message "executing haskell source code block") (message "executing haskell source code block")
@ -61,10 +68,7 @@
(session (first processed-params)) (session (first processed-params))
(vars (second processed-params)) (vars (second processed-params))
(result-type (fourth processed-params)) (result-type (fourth processed-params))
(full-body (concat (full-body (org-babel-expand-body:haskell body params processed-params))
(mapconcat
(lambda (pair) (format "let %s = %s;" (car pair) (cdr pair)))
vars "\n") "\n" body "\n"))
(session (org-babel-prep-session:haskell session params)) (session (org-babel-prep-session:haskell session params))
(raw (org-babel-comint-with-output session org-babel-haskell-eoe t (raw (org-babel-comint-with-output session org-babel-haskell-eoe t
(insert (org-babel-trim full-body)) (insert (org-babel-trim full-body))
@ -75,9 +79,12 @@
#'org-babel-haskell-read-string #'org-babel-haskell-read-string
(cdr (member org-babel-haskell-eoe (cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-babel-trim raw))))))) (reverse (mapcar #'org-babel-trim raw)))))))
(org-babel-reassemble-table
(case result-type (case result-type
(output (mapconcat #'identity (reverse (cdr results)) "\n")) (output (mapconcat #'identity (reverse (cdr results)) "\n"))
(value (org-babel-haskell-table-or-string (car results)))))) (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))))))
(defun org-babel-haskell-read-string (string) (defun org-babel-haskell-read-string (string)
"Strip \\\"s from around haskell string" "Strip \\\"s from around haskell string"

12
contrib/babel/lisp/langs/org-babel-latex.el
View File

@ -43,10 +43,7 @@
'((:results . "latex") (:exports . "results")) '((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a latex source block.") "Default arguments to use when evaluating a latex source block.")
(defun org-babel-execute:latex (body params) (defun org-babel-expand-body:latex (body params &optional processed-params)
"Execute a block of Latex code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Latex source code block")
(mapc (lambda (pair) ;; replace variables (mapc (lambda (pair) ;; replace variables
(setq body (setq body
(replace-regexp-in-string (replace-regexp-in-string
@ -54,6 +51,13 @@ called by `org-babel-execute-src-block'."
(if (stringp (cdr pair)) (if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair))) (cdr pair) (format "%S" (cdr pair)))
body))) (second (org-babel-process-params params))) body))) (second (org-babel-process-params params)))
body)
(defun org-babel-execute:latex (body params)
"Execute a block of Latex code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Latex source code block")
(setq body (org-babel-expand-body:latex body params))
(if (cdr (assoc :file params)) (if (cdr (assoc :file params))
(let ((out-file (cdr (assoc :file params))) (let ((out-file (cdr (assoc :file params)))
(tex-file (make-temp-file "org-babel-latex" nil ".tex")) (tex-file (make-temp-file "org-babel-latex" nil ".tex"))

2
contrib/babel/lisp/langs/org-babel-matlab.el
View File

@ -48,6 +48,8 @@
(defvar org-babel-matlab-shell-command "matlab -nosplash" (defvar org-babel-matlab-shell-command "matlab -nosplash"
"Shell command to use to run matlab as an external process.") "Shell command to use to run matlab as an external process.")
(defun org-babel-expand-body:matlab (body params &optional processed-params) body)
(defun org-babel-execute:matlab (body params) (defun org-babel-execute:matlab (body params)
"Execute a block of matlab code with org-babel." "Execute a block of matlab code with org-babel."
(org-babel-execute:octave body params 'matlab)) (org-babel-execute:octave body params 'matlab))

17
contrib/babel/lisp/langs/org-babel-ocaml.el
View File

@ -48,22 +48,29 @@
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") (defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "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)
(let ((vars (second (or processed-params (org-babel-process-params params)))))
(concat
(mapconcat
(lambda (pair) (format "let %s = %s;" (car pair) (cdr pair)))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:ocaml (body params) (defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with org-babel." "Execute a block of Ocaml code with org-babel."
(message "executing ocaml source code block") (message "executing ocaml source code block")
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(vars (second processed-params)) (vars (second processed-params))
(full-body (concat (full-body (org-babel-expand-body:ocaml body params processed-params))
(mapconcat
(lambda (pair) (format "let %s = %s;" (car pair) (cdr pair)))
vars "\n") "\n" body "\n"))
(session (org-babel-prep-session:ocaml session params)) (session (org-babel-prep-session:ocaml session params))
(raw (org-babel-comint-with-output session org-babel-ocaml-eoe-output t (raw (org-babel-comint-with-output session org-babel-ocaml-eoe-output t
(insert (concat (org-babel-chomp full-body) " ;;")) (insert (concat (org-babel-chomp full-body) " ;;"))
(comint-send-input nil t) (comint-send-input nil t)
(insert org-babel-ocaml-eoe-indicator) (insert org-babel-ocaml-eoe-indicator)
(comint-send-input nil t)))) (comint-send-input nil t))))
(org-babel-ocaml-parse-output (org-babel-trim (car raw))))) (org-babel-reassemble-table
(org-babel-ocaml-parse-output (org-babel-trim (car raw)))
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))
(defun org-babel-prep-session:ocaml (session params) (defun org-babel-prep-session:ocaml (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

28
contrib/babel/lisp/langs/org-babel-octave.el
View File

@ -41,6 +41,18 @@
(defvar org-babel-octave-shell-command "octave -q" (defvar org-babel-octave-shell-command "octave -q"
"Shell command to use to run octave as an external process.") "Shell command to use to run octave as an external process.")
(defun org-babel-expand-body:octave (org-babel-process-params params)
(let ((vars (second (or processed-params (org-babel-process-params params)))))
(concat
;; prepend code to define all arguments passed to the code block
;; (may not be appropriate for all languages)
(mapconcat
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
vars "\n") "\n" body "\n")))
(defun org-babel-execute:octave (body params &optional matlabp) (defun org-babel-execute:octave (body params &optional matlabp)
"Execute a block of octave code with org-babel." "Execute a block of octave code with org-babel."
(message (format "executing %s source code block" (if matlabp "matlab" "octave"))) (message (format "executing %s source code block" (if matlabp "matlab" "octave")))
@ -52,17 +64,13 @@
(result-params (third processed-params)) (result-params (third processed-params))
(result-type (fourth processed-params)) (result-type (fourth processed-params))
(out-file (cdr (assoc :file params))) (out-file (cdr (assoc :file params)))
(augmented-body (concat (augmented-body (org-babel-expand-body:octave body params processed-params))
;; prepend code to define all arguments passed to the code block
;; (may not be appropriate for all languages)
(mapconcat
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
vars "\n") "\n" body "\n"))
(result (org-babel-octave-evaluate session augmented-body result-type matlabp))) (result (org-babel-octave-evaluate session augmented-body result-type matlabp)))
(or out-file result))) (or out-file
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
(defun org-babel-octave-var-to-octave (var) (defun org-babel-octave-var-to-octave (var)
"Convert an emacs-lisp variable into an octave variable. "Convert an emacs-lisp variable into an octave variable.

27
contrib/babel/lisp/langs/org-babel-oz.el
View File

@ -204,16 +204,9 @@ StartOzServer.oz is located.")
(setq org-babel-oz-collected-result nil)))) (setq org-babel-oz-collected-result nil))))
result)) result))
(defun org-babel-expand-body:oz (body params &optional processed-params)
(defun org-babel-execute:oz (body params) (let ((vars (second (or processed-params (org-babel-process-params params))))))
"Execute a block of Oz code with org-babel. This function is (if vars
called by `org-babel-execute-src-block' via multiple-value-bind."
(let* ((processed-params (org-babel-process-params params))
;; (session (org-babel-ruby-initiate-session (first processed-params)))
(vars (second processed-params))
;; (result-params (third processed-params))
(result-type (fourth processed-params))
(full-body (if vars
;; only add var declarations if any variables are there ;; only add var declarations if any variables are there
(concat (concat
;; prepend code to define all arguments passed to the code block ;; prepend code to define all arguments passed to the code block
@ -228,12 +221,23 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
body body
"end\n") "end\n")
body)) body))
(defun org-babel-execute:oz (body params)
"Execute a block of Oz code with org-babel. This function is
called by `org-babel-execute-src-block' via multiple-value-bind."
(let* ((processed-params (org-babel-process-params params))
;; (session (org-babel-ruby-initiate-session (first processed-params)))
(vars (second processed-params))
;; (result-params (third processed-params))
(result-type (fourth processed-params))
(full-body (org-babel-expand-body:oz body params processed-params))
(wait-time (plist-get params :wait-time)) (wait-time (plist-get params :wait-time))
;; set the session if the session variable is non-nil ;; set the session if the session variable is non-nil
;; (session-buffer (org-babel-oz-initiate-session session)) ;; (session-buffer (org-babel-oz-initiate-session session))
;; (session (org-babel-prep-session:oz session params)) ;; (session (org-babel-prep-session:oz session params))
) )
;; actually execute the source-code block ;; actually execute the source-code block
(org-babel-reassemble-table
(case result-type (case result-type
(output (output
(progn (progn
@ -245,7 +249,8 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
(oz-send-string-expression full-body (if wait-time (oz-send-string-expression full-body (if wait-time
wait-time wait-time
1))))) 1)))))
)) (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))
;; This function should be used to assign any variables in params in ;; This function should be used to assign any variables in params in
;; the context of the session environment. ;; the context of the session environment.

24
contrib/babel/lisp/langs/org-babel-perl.el
View File

@ -35,6 +35,16 @@
(add-to-list 'org-babel-tangle-langs '("perl" "pl" "#!/usr/bin/env perl")) (add-to-list 'org-babel-tangle-langs '("perl" "pl" "#!/usr/bin/env perl"))
(defun org-babel-expand-body:perl (body params &optional processed-params)
(let ((vars (second (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) (defun org-babel-execute:perl (body params)
"Execute a block of Perl code with org-babel. This function is "Execute a block of Perl code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
@ -44,15 +54,13 @@ called by `org-babel-execute-src-block'."
(vars (second processed-params)) (vars (second processed-params))
(result-params (third processed-params)) (result-params (third processed-params))
(result-type (fourth processed-params)) (result-type (fourth processed-params))
(full-body (concat (full-body (org-babel-expand-body:perl
(mapconcat ;; define any variables body params processed-params)) ;; then the source block body
(lambda (pair)
(format "$%s=%s;"
(car pair)
(org-babel-perl-var-to-perl (cdr pair))))
vars "\n") "\n" (org-babel-trim body) "\n")) ;; then the source block body
(session (org-babel-perl-initiate-session session))) (session (org-babel-perl-initiate-session session)))
(org-babel-perl-evaluate session full-body result-type))) (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)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))
(defun org-babel-prep-session:perl (session params) (defun org-babel-prep-session:perl (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

27
contrib/babel/lisp/langs/org-babel-python.el
View File

@ -36,25 +36,32 @@
(add-to-list 'org-babel-tangle-langs '("python" "py" "#!/usr/bin/env python")) (add-to-list 'org-babel-tangle-langs '("python" "py" "#!/usr/bin/env python"))
(defun org-babel-expand-body:python (body params &optional processed-params)
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
(second (or processed-params (org-babel-process-params params))) "\n")
"\n" (org-babel-trim body) "\n"))
(defun org-babel-execute:python (body params) (defun org-babel-execute:python (body params)
"Execute a block of Python code with org-babel. This function is "Execute a block of Python code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
(message "executing Python source code block") (message "executing Python source code block")
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(session (org-babel-python-initiate-session (first processed-params))) (session (org-babel-python-initiate-session (first processed-params)))
(vars (second processed-params))
(result-params (third processed-params)) (result-params (third processed-params))
(result-type (fourth processed-params)) (result-type (fourth processed-params))
(full-body (concat (full-body (org-babel-expand-body:python
(mapconcat ;; define any variables body params processed-params)) ;; then the source block body
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
vars "\n") "\n" (org-babel-trim body) "\n")) ;; then the source block body
(result (org-babel-python-evaluate session full-body result-type))) (result (org-babel-python-evaluate session full-body result-type)))
(or (cdr (assoc :file params)) result))) (or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:python (session params) (defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

26
contrib/babel/lisp/langs/org-babel-ruby.el
View File

@ -46,24 +46,32 @@
(add-to-list 'org-babel-tangle-langs '("ruby" "rb" "#!/usr/bin/env ruby")) (add-to-list 'org-babel-tangle-langs '("ruby" "rb" "#!/usr/bin/env ruby"))
(defun org-babel-expand-body:ruby (body params &optional processed-params)
(let ((vars (second (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) (defun org-babel-execute:ruby (body params)
"Execute a block of Ruby code with org-babel. This function is "Execute a block of Ruby code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
(message "executing Ruby source code block") (message "executing Ruby source code block")
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(session (org-babel-ruby-initiate-session (first processed-params))) (session (org-babel-ruby-initiate-session (first processed-params)))
(vars (second processed-params))
(result-params (third processed-params)) (result-params (third processed-params))
(result-type (fourth processed-params)) (result-type (fourth processed-params))
(full-body (concat (full-body (org-babel-expand-body:ruby
(mapconcat ;; define any variables body params processed-params)) ;; then the source block body
(lambda (pair)
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
vars "\n") "\n" body "\n")) ;; then the source block body
(result (org-babel-ruby-evaluate session full-body result-type))) (result (org-babel-ruby-evaluate session full-body result-type)))
(or (cdr (assoc :file params)) result))) (or (cdr (assoc :file params))
(org-babel-reassemble-table
result
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:ruby (session params) (defun org-babel-prep-session:ruby (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

5
contrib/babel/lisp/langs/org-babel-sass.el
View File

@ -48,6 +48,8 @@
(add-to-list 'org-babel-tangle-langs '("sass" "sass")) (add-to-list 'org-babel-tangle-langs '("sass" "sass"))
(defun org-babel-expand-body:sass (body params &optional processed-params) body)
(defun org-babel-execute:sass (body params) (defun org-babel-execute:sass (body params)
"Execute a block of Sass code with org-babel. This function is "Execute a block of Sass code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
@ -58,7 +60,8 @@ called by `org-babel-execute-src-block'."
(cmdline (cdr (assoc :cmdline params))) (cmdline (cdr (assoc :cmdline params)))
(in-file (make-temp-file "org-babel-sass-in")) (in-file (make-temp-file "org-babel-sass-in"))
(cmd (concat "sass " (or cmdline "") in-file " " out-file))) (cmd (concat "sass " (or cmdline "") in-file " " out-file)))
(with-temp-file in-file (insert body)) (shell-command cmd) (with-temp-file in-file
(insert (org-babel-expand-body:sass body params))) (shell-command cmd)
(or file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) (or file (with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
(defun org-babel-prep-session:sass (session params) (defun org-babel-prep-session:sass (session params)

5
contrib/babel/lisp/langs/org-babel-screen.el
View File

@ -50,6 +50,8 @@ In case you want to use a different screen than one selected by your $PATH")
'((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm"))
"Default arguments to use when running screen source blocks.") "Default arguments to use when running screen source blocks.")
(defun org-babel-expand-body:screen (body params &optional processed-params) body)
(defun org-babel-execute:screen (body params) (defun org-babel-execute:screen (body params)
"Send a block of code via screen to a terminal using org-babel. "Send a block of code via screen to a terminal using org-babel.
\"default\" session is be used when none is specified." \"default\" session is be used when none is specified."
@ -59,7 +61,8 @@ In case you want to use a different screen than one selected by your $PATH")
(session (first processed-params)) (session (first processed-params))
(socket (org-babel-screen-session-socketname session))) (socket (org-babel-screen-session-socketname session)))
(unless socket (org-babel-prep-session:screen session params)) (unless socket (org-babel-prep-session:screen session params))
(org-babel-screen-session-execute-string session body)))) (org-babel-screen-session-execute-string
session (org-babel-expand-body:screen body)))))
(defun org-babel-prep-session:screen (session params) (defun org-babel-prep-session:screen (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

27
contrib/babel/lisp/langs/org-babel-sh.el
View File

@ -40,23 +40,30 @@
"Command used to invoke a shell. This will be passed to "Command used to invoke a shell. This will be passed to
`shell-command-on-region'") `shell-command-on-region'")
(defun org-babel-expand-body:sh (body params &optional processed-params)
(let ((vars (second (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") "\n" body "\n\n")))
(defun org-babel-execute:sh (body params) (defun org-babel-execute:sh (body params)
"Execute a block of Shell commands with org-babel. This "Execute a block of Shell commands with org-babel. This
function is called by `org-babel-execute-src-block'." function is called by `org-babel-execute-src-block'."
(message "executing Shell source code block") (message "executing Shell source code block")
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(session (org-babel-sh-initiate-session (first processed-params))) (session (org-babel-sh-initiate-session (first processed-params)))
(vars (second processed-params))
(result-type (fourth processed-params)) (result-type (fourth processed-params))
(sep (cdr (assoc :separator params))) (full-body (org-babel-expand-body:sh
(full-body (concat body params processed-params))) ;; then the source block body
(mapconcat ;; define any variables (org-babel-reassemble-table
(lambda (pair) (org-babel-sh-evaluate session full-body result-type)
(format "%s=%s" (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params)))
(car pair) (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))
(org-babel-sh-var-to-sh (cdr pair) sep)))
vars "\n") "\n" body "\n\n"))) ;; then the source block body
(org-babel-sh-evaluate session full-body result-type)))
(defun org-babel-prep-session:sh (session params) (defun org-babel-prep-session:sh (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

11
contrib/babel/lisp/langs/org-babel-sql.el
View File

@ -51,6 +51,8 @@
(add-to-list 'org-babel-tangle-langs '("sql" "sql")) (add-to-list 'org-babel-tangle-langs '("sql" "sql"))
(defun org-babel-expand-body:sql (body params &optional processed-params) body)
(defun org-babel-execute:sql (body params) (defun org-babel-execute:sql (body params)
"Execute a block of Sql code with org-babel. This function is "Execute a block of Sql code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
@ -65,12 +67,17 @@ called by `org-babel-execute-src-block'."
('mysql (format "mysql %s -e \"source %s\" > %s" ('mysql (format "mysql %s -e \"source %s\" > %s"
(or cmdline "") in-file out-file)) (or cmdline "") in-file out-file))
(t (error "no support for the %s sql engine"))))) (t (error "no support for the %s sql engine")))))
(with-temp-file in-file (insert body)) (with-temp-file in-file
(insert (org-babel-expand-body:sql body params)))
(message command) (message command)
(shell-command command) (shell-command command)
(with-temp-buffer (with-temp-buffer
(org-table-import out-file nil) (org-table-import out-file nil)
(org-table-to-lisp)))) (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)))))))
(defun org-babel-prep-session:sql (session params) (defun org-babel-prep-session:sql (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."

3
contrib/babel/lisp/org-babel-keys.el
View File

@ -48,7 +48,8 @@ interactive babel functions which are assigned key bindings.")
("h" . org-babel-sha1-hash) ("h" . org-babel-sha1-hash)
("g" . org-babel-goto-named-source-block) ("g" . org-babel-goto-named-source-block)
("l" . org-babel-lob-ingest) ("l" . org-babel-lob-ingest)
("z" . org-babel-switch-to-session)) ("z" . org-babel-switch-to-session)
("p" . org-babel-expand-src-block))
"Org-babel keybindings. This list associates interactive "Org-babel keybindings. This list associates interactive
org-babel functions with keys. Each element of this list will org-babel functions with keys. Each element of this list will
add an entry to the `org-mode-map' using the letter key which is add an entry to the `org-mode-map' using the letter key which is

19
contrib/babel/lisp/org-babel-tangle.el
View File

@ -177,17 +177,26 @@ code blocks by language."
(format "block-%d" block-counter)))) (format "block-%d" block-counter))))
(src-lang (first info)) (src-lang (first info))
(params (third info)) (params (third info))
(body (if (equal "no" (cdr (assoc :noweb params)))
(second info)
(org-babel-expand-noweb-references info)))
(spec (list link source-name params body (third (cdr (assoc src-lang org-babel-tangle-langs)))))
by-lang) by-lang)
(unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip (unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip
(unless (and lang (not (string= lang src-lang))) ;; maybe limit by language (unless (and lang (not (string= lang src-lang))) ;; maybe limit by language
;; add the spec for this block to blocks under it's language ;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks))) (setq by-lang (cdr (assoc src-lang blocks)))
(setq blocks (delq (assoc src-lang blocks) blocks)) (setq blocks (delq (assoc src-lang blocks) blocks))
(setq blocks (cons (cons src-lang (cons spec by-lang)) blocks)))))) (setq blocks
(cons
(cons src-lang
(cons (list link source-name params
(funcall
(intern
(concat "org-babel-expand-body:" src-lang))
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info) (second info))
params)
(third (cdr (assoc
src-lang org-babel-tangle-langs))))
by-lang)) blocks))))))
;; ensure blocks in the correct order ;; ensure blocks in the correct order
(setq blocks (setq blocks
(mapcar (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) blocks)) (mapcar (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) blocks))

351
contrib/babel/lisp/org-babel.el
View File

@ -36,10 +36,18 @@
then run `org-babel-execute-src-block'." then run `org-babel-execute-src-block'."
(interactive) (interactive)
(let ((info (org-babel-get-src-block-info))) (let ((info (org-babel-get-src-block-info)))
(if info (progn (org-babel-execute-src-block current-prefix-arg info) t) nil))) (if info
(progn (org-babel-execute-src-block current-prefix-arg info) t) nil)))
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe) (add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe)
(defun org-babel-expand-src-block-maybe ()
"Detect if this is context for a org-babel src-block and if so
then run `org-babel-expand-src-block'."
(interactive)
(let ((info (org-babel-get-src-block-info)))
(if info (progn (org-babel-expand-src-block current-prefix-arg info) t) nil)))
(defadvice org-edit-special (around org-babel-prep-session-for-edit activate) (defadvice org-edit-special (around org-babel-prep-session-for-edit activate)
"Prepare the current source block's session according to it's "Prepare the current source block's session according to it's
header arguments before editing in an org-src buffer. This header arguments before editing in an org-src buffer. This
@ -50,8 +58,9 @@ prefix argument from inside of a source-code block."
(lang (first info)) (lang (first info))
(params (third info)) (params (third info))
(session (cdr (assoc :session params)))) (session (cdr (assoc :session params))))
(when (and info session) ;; if we are in a source-code block which has a session (when (and info session) ;; we are in a source-code block with a session
(funcall (intern (concat "org-babel-prep-session:" lang)) session params)))) (funcall
(intern (concat "org-babel-prep-session:" lang)) session params))))
ad-do-it) ad-do-it)
(defadvice org-open-at-point (around org-babel-open-at-point activate) (defadvice org-open-at-point (around org-babel-open-at-point activate)
@ -86,7 +95,8 @@ individual languages may define their own language specific
header arguments as well.") header arguments as well.")
(defvar org-babel-default-header-args (defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no")) '((:session . "none") (:results . "replace") (:exports . "code")
(:cache . "no") (:noweb . "no") (:hlines . "no"))
"Default arguments to use when evaluating a source block.") "Default arguments to use when evaluating a source block.")
(defvar org-babel-default-inline-header-args (defvar org-babel-default-inline-header-args
@ -133,7 +143,8 @@ can not be resolved.")
(defun org-babel-set-interpreters (var value) (defun org-babel-set-interpreters (var value)
(set-default var value) (set-default var value)
(setq org-babel-src-block-regexp (setq
org-babel-src-block-regexp
(concat "^[ \t]*#\\+begin_src[ \t]+\\(" ;; (1) lang (concat "^[ \t]*#\\+begin_src[ \t]+\\(" ;; (1) lang
(mapconcat 'regexp-quote value "\\|") (mapconcat 'regexp-quote value "\\|")
"\\)[ \t]*" "\\)[ \t]*"
@ -206,14 +217,15 @@ block."
(sort (org-babel-merge-params (third info) params) (sort (org-babel-merge-params (third info) params)
(lambda (el1 el2) (string< (symbol-name (car el1)) (lambda (el1 el2) (string< (symbol-name (car el1))
(symbol-name (car el2))))))) (symbol-name (car el2)))))))
(new-hash (if (and (cdr (assoc :cache params)) (new-hash
(string= "yes" (cdr (assoc :cache params)))) (org-babel-sha1-hash info))) (if (and (cdr (assoc :cache params))
(string= "yes" (cdr (assoc :cache params))))
(org-babel-sha1-hash info)))
(old-hash (org-babel-result-hash info)) (old-hash (org-babel-result-hash info))
(body (setf (second info) (body (setf (second info)
(if (and (cdr (assoc :noweb params)) (if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params)))) (string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info) (second info)))) (org-babel-expand-noweb-references info) (second info))))
(result-params (split-string (or (cdr (assoc :results params)) ""))) (result-params (split-string (or (cdr (assoc :results params)) "")))
(result-type (cond ((member "output" result-params) 'output) (result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value) ((member "value" result-params) 'value)
@ -236,7 +248,8 @@ block."
(goto-char (org-babel-where-is-src-block-result nil info)) (goto-char (org-babel-where-is-src-block-result nil info))
(move-end-of-line 1) (forward-char 1) (move-end-of-line 1) (forward-char 1)
(setq result (org-babel-read-result)) (setq result (org-babel-read-result))
(message (replace-regexp-in-string "%" "%%" (format "%S" result))) result) (message (replace-regexp-in-string "%" "%%"
(format "%S" result))) result)
(setq result (funcall cmd body params)) (setq result (funcall cmd body params))
(if (eq result-type 'value) (if (eq result-type 'value)
(setq result (if (and (or (member "vector" result-params) (setq result (if (and (or (member "vector" result-params)
@ -249,6 +262,33 @@ block."
result)) result))
(setq call-process-region 'call-process-region-original)))) (setq call-process-region 'call-process-region-original))))
(defun org-babel-expand-body:generic (body params &optional processed-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)
(defun org-babel-expand-src-block (&optional arg info params)
"Expand the current source code block according to it's header
arguments, and pop open the results in a preview buffer."
(interactive)
;; (message "supplied params=%S" params) ;; debugging
(let* ((info (or info (org-babel-get-src-block-info)))
(lang (first info))
(params (setf (third info)
(sort (org-babel-merge-params (third info) params)
(lambda (el1 el2) (string< (symbol-name (car el1))
(symbol-name (car el2)))))))
(body (setf (second info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info) (second info))))
(cmd (intern (concat "org-babel-expand-body:" lang)))
(expanded (funcall (if (fboundp cmd) cmd 'org-babel-expand-body:generic)
body params)))
(org-edit-src-code
nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))))
(defun org-babel-load-in-session (&optional arg info) (defun org-babel-load-in-session (&optional arg info)
"Load the body of the current source-code block. Evaluate the "Load the body of the current source-code block. Evaluate the
header arguments for the source block before entering the header arguments for the source block before entering the
@ -262,7 +302,9 @@ session. After loading the body this pops open the session."
(unless (member lang org-babel-interpreters) (unless (member lang org-babel-interpreters)
(error "Language is not in `org-babel-interpreters': %s" lang)) (error "Language is not in `org-babel-interpreters': %s" lang))
;; if called with a prefix argument, then process header arguments ;; if called with a prefix argument, then process header arguments
(pop-to-buffer (funcall (intern (concat "org-babel-load-session:" lang)) session body params)) (pop-to-buffer
(funcall (intern (concat "org-babel-load-session:" lang))
session body params))
(move-end-of-line 1))) (move-end-of-line 1)))
(defun org-babel-switch-to-session (&optional arg info) (defun org-babel-switch-to-session (&optional arg info)
@ -282,11 +324,15 @@ of the source block to the kill ring."
(unless (member lang org-babel-interpreters) (unless (member lang org-babel-interpreters)
(error "Language is not in `org-babel-interpreters': %s" lang)) (error "Language is not in `org-babel-interpreters': %s" lang))
;; copy body to the kill ring ;; copy body to the kill ring
(with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max))) (with-temp-buffer (insert (org-babel-trim body))
(copy-region-as-kill (point-min) (point-max)))
;; if called with a prefix argument, then process header arguments ;; if called with a prefix argument, then process header arguments
(if arg (funcall (intern (concat "org-babel-prep-session:" lang)) session params)) (when arg
(funcall (intern (concat "org-babel-prep-session:" lang)) session params))
;; just to the session using pop-to-buffer ;; just to the session using pop-to-buffer
(pop-to-buffer (funcall (intern (format "org-babel-%s-initiate-session" lang)) session params)) (pop-to-buffer
(funcall (intern (format "org-babel-%s-initiate-session" lang))
session params))
(move-end-of-line 1))) (move-end-of-line 1)))
(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) (defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
@ -355,17 +401,21 @@ added to the header-arguments-alist."
(goto-char head) (goto-char head)
(setq info (org-babel-parse-src-block-match)) (setq info (org-babel-parse-src-block-match))
(forward-line -1) (forward-line -1)
(when (looking-at (concat org-babel-source-name-regexp (when (looking-at
(concat org-babel-source-name-regexp
"\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")) "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
(setq info (append info (list (org-babel-clean-text-properties (match-string 2))))) (setq info (append info (list (org-babel-clean-text-properties
(match-string 2)))))
;; Note that e.g. "name()" and "name( )" result in ((:var . "")). ;; Note that e.g. "name()" and "name( )" result in ((:var . "")).
;; We maintain that behaviour, and the resulting non-nil sixth ;; We maintain that behaviour, and the resulting non-nil sixth
;; element is relied upon in org-babel-exp-code to detect a functional-style ;; element is relied upon in org-babel-exp-code to detect
;; block in those cases. However, "name" without any ;; a functional-style block in those cases. However,
;; parentheses would result in the same thing, so we ;; "name" without any parentheses would result in the same
;; explicitly avoid that. ;; thing, so we explicitly avoid that.
(if (setq args (match-string 4)) (if (setq args (match-string 4))
(setq info (append info (list (mapcar (lambda (ref) (cons :var ref)) (setq info
(append info (list
(mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args args)))))) (org-babel-ref-split-args args))))))
(unless header-vars-only (unless header-vars-only
(setf (third info) (setf (third info)
@ -517,7 +567,7 @@ with C-c C-c."
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(save-match-data ,@body) (save-match-data ,@body)
(goto-char (match-end 0)))) (goto-char (match-end 0))))
(unless visited-p (kill-buffer (file-name-nondirectory file))))) (unless visited-p (kill-buffer (file-name-nondirectory ,file)))))
(defun org-babel-params-from-properties () (defun org-babel-params-from-properties ()
"Return an association list of any source block params which "Return an association list of any source block params which
@ -543,7 +593,7 @@ may be specified in the properties of the current outline entry."
(preserve-indentation (or org-src-preserve-indentation (preserve-indentation (or org-src-preserve-indentation
(string-match "-i\\>" switches)))) (string-match "-i\\>" switches))))
(list lang (list lang
;; get src block body removing properties, protective commas, and indentation ;; get block body less properties, protective commas, and indentation
(with-temp-buffer (with-temp-buffer
(save-match-data (save-match-data
(insert (org-babel-strip-protective-commas body)) (insert (org-babel-strip-protective-commas body))
@ -553,19 +603,22 @@ may be specified in the properties of the current outline entry."
org-babel-default-header-args org-babel-default-header-args
(org-babel-params-from-properties) (org-babel-params-from-properties)
(if (boundp lang-headers) (eval lang-headers) nil) (if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))) (org-babel-parse-header-arguments
(org-babel-clean-text-properties (or (match-string 3) ""))))
switches))) switches)))
(defun org-babel-parse-inline-src-block-match () (defun org-babel-parse-inline-src-block-match ()
(let* ((lang (org-babel-clean-text-properties (match-string 2))) (let* ((lang (org-babel-clean-text-properties (match-string 2)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))) (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang (list lang
(org-babel-strip-protective-commas (org-babel-clean-text-properties (match-string 5))) (org-babel-strip-protective-commas
(org-babel-clean-text-properties (match-string 5)))
(org-babel-merge-params (org-babel-merge-params
org-babel-default-inline-header-args org-babel-default-inline-header-args
(org-babel-params-from-properties) (org-babel-params-from-properties)
(if (boundp lang-headers) (eval lang-headers) nil) (if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 4) ""))))))) (org-babel-parse-header-arguments
(org-babel-clean-text-properties (or (match-string 4) "")))))))
(defun org-babel-parse-header-arguments (arg-string) (defun org-babel-parse-header-arguments (arg-string)
"Parse a string of header arguments returning an alist." "Parse a string of header arguments returning an alist."
@ -573,24 +626,125 @@ may be specified in the properties of the current outline entry."
(delq nil (delq nil
(mapcar (mapcar
(lambda (arg) (lambda (arg)
(if (string-match "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg) (if (string-match
"\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
arg)
(cons (intern (concat ":" (match-string 1 arg))) (cons (intern (concat ":" (match-string 1 arg)))
(let ((raw (org-babel-chomp (match-string 2 arg)))) (let ((raw (org-babel-chomp (match-string 2 arg))))
(if (org-babel-number-p raw) raw (org-babel-read raw)))) (if (org-babel-number-p raw)
raw (org-babel-read raw))))
(cons (intern (concat ":" arg)) nil))) (cons (intern (concat ":" arg)) nil)))
(split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))) (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))))
(defun org-babel-process-params (params) (defun org-babel-process-params (params)
"Parse params and resolve references. "Parse params and resolve references.
Return a list (session vars result-params result-type)." Return a list (session vars result-params result-type colnames rownames)."
(let* ((session (cdr (assoc :session params))) (let* ((session (cdr (assoc :session params)))
(vars (org-babel-ref-variables 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-params (split-string (or (cdr (assoc :results params)) "")))
(result-type (cond ((member "output" result-params) 'output) (result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value) ((member "value" result-params) 'value)
(t 'value)))) (t 'value))))
(list session vars result-params result-type))) (list session vars result-params result-type colnames rownames)))
;; row and column names
(defun org-babel-del-hlines (table)
"Remove all 'hlines from TABLE."
(remove 'hline table))
(defun org-babel-get-colnames (table)
"Return a cons cell, the `car' of which contains the TABLE
less colnames, and the `cdr' of which contains a list of the
column names"
(if (equal 'hline (second table))
(cons (cddr table) (car table))
(list table)))
(defun org-babel-get-rownames (table)
"Return a cons cell, the `car' of which contains the TABLE less
colnames, and the `cdr' of which contains a list of the column
names. Note: this function removes any hlines in TABLE"
(flet ((trans (table) (apply #'mapcar* #'list table)))
(let* ((width (apply 'max (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
(table (trans (mapcar (lambda (row)
(if (not (equal row 'hline))
row
(setq row '())
(dotimes (n width) (setq row (cons 'hline row)))
row))
table))))
(cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
(trans (cdr table)))
(remove 'hline (car table))))))
(defun org-babel-put-colnames (table colnames)
"Add COLNAMES to TABLE if they exist."
(if colnames (apply 'list colnames 'hline table) table))
(defun org-babel-put-rownames (table rownames)
"Add ROWNAMES to TABLE if they exist."
(if rownames
(mapcar (lambda (row)
(if (listp row)
(cons (or (pop rownames) "") row)
row)) table)
table))
(defun org-babel-pick-name (names selector)
"Select one out of an alist of row or column names."
(when names
(if (and selector (symbolp selector) (not (equal t selector)))
(cdr (assoc selector names))
(if (integerp selector)
(nth (- selector 1) names)
(cdr (car (last names)))))))
(defun org-babel-disassemble-tables (vars hlines colnames rownames)
"Process the variables in VARS according to the HLINES,
ROWNAMES and COLNAMES header arguments. Return a list consisting
of the vars, cnames and rnames."
(let (cnames rnames)
(list
(mapcar
(lambda (var)
(when (listp (cdr var))
(when (and (not (equal colnames "no"))
(or colnames (and (equal (second (cdr var)) 'hline)
(not (member 'hline (cddr (cdr var)))))))
(let ((both (org-babel-get-colnames (cdr var))))
(setq cnames (cons (cons (car var) (cdr both))
cnames))
(setq var (cons (car var) (car both)))))
(when (and rownames (not (equal rownames "no")))
(let ((both (org-babel-get-rownames (cdr var))))
(setq rnames (cons (cons (car var) (cdr both))
rnames))
(setq var (cons (car var) (car both)))))
(when (and hlines (not (equal hlines "yes")))
(setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
var)
vars)
cnames rnames)))
(defun org-babel-reassemble-table (table colnames rownames)
"Given a TABLE and set of COLNAMES and ROWNAMES add the names
to the table for reinsertion to org-mode."
(if (listp table)
((lambda (table)
(if (and colnames (listp (car table)) (= (length (car table))
(length colnames)))
(org-babel-put-colnames table colnames) table))
(if (and rownames (= (length table) (length rownames)))
(org-babel-put-rownames table rownames) table))
table))
(defun org-babel-where-is-src-block-head () (defun org-babel-where-is-src-block-head ()
"Return the point at the beginning of the current source "Return the point at the beginning of the current source
@ -644,7 +798,8 @@ buffer or nil if no such result exists."
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward (when (re-search-forward
(concat org-babel-result-regexp "[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t) (concat org-babel-result-regexp
"[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
(move-beginning-of-line 0) (point)))) (move-beginning-of-line 0) (point))))
(defun org-babel-where-is-src-block-result (&optional insert info hash) (defun org-babel-where-is-src-block-result (&optional insert info hash)
@ -668,13 +823,18 @@ following the source block."
(progn ;; unnamed results line already exists (progn ;; unnamed results line already exists
(re-search-forward "[^ \f\t\n\r\v]" nil t) (re-search-forward "[^ \f\t\n\r\v]" nil t)
(move-beginning-of-line 1) (move-beginning-of-line 1)
(looking-at (concat org-babel-result-regexp "\n")))) (looking-at
;; or (with optional insert) back up and make one ourselves (concat org-babel-result-regexp "\n"))))
;; or (with optional insert) back up and
;; make one ourselves
(when insert (when insert
(goto-char end) (goto-char end)
(if (looking-at "[\n\r]") (forward-char 1) (insert "\n")) (if (looking-at "[\n\r]")
(insert (concat "#+results" (if hash (concat "["hash"]")) (forward-char 1) (insert "\n"))
":"(if name (concat " " name)) "\n")) (insert (concat "#+results"
(when hash (concat "["hash"]"))
":"
(when name (concat " " name)) "\n"))
(move-beginning-of-line 0) (move-beginning-of-line 0)
(if hash (org-babel-hide-hash)) t))) (if hash (org-babel-hide-hash)) t)))
(point)))))) (point))))))
@ -689,12 +849,14 @@ following the source block."
((looking-at ": ") ((looking-at ": ")
(setq result-string (setq result-string
(org-babel-trim (org-babel-trim
(mapconcat (lambda (line) (if (and (> (length line) 1) (mapconcat (lambda (line)
(if (and (> (length line) 1)
(string= ": " (substring line 0 2))) (string= ": " (substring line 0 2)))
(substring line 2) (substring line 2)
line)) line))
(split-string (split-string
(buffer-substring (point) (org-babel-result-end)) "[\r\n]+") (buffer-substring
(point) (org-babel-result-end)) "[\r\n]+")
"\n"))) "\n")))
(or (org-babel-number-p result-string) result-string)) (or (org-babel-number-p result-string) result-string))
((looking-at org-babel-result-regexp) ((looking-at org-babel-result-regexp)
@ -776,7 +938,8 @@ code ---- the results are extracted in the syntax of the source
(setq result (concat result "\n"))) (setq result (concat result "\n")))
(save-excursion (save-excursion
(let ((existing-result (org-babel-where-is-src-block-result t info hash)) (let ((existing-result (org-babel-where-is-src-block-result t info hash))
(results-switches (cdr (assoc :results_switches (third info)))) beg) (results-switches
(cdr (assoc :results_switches (third info)))) beg)
(when existing-result (goto-char existing-result) (forward-line 1)) (when existing-result (goto-char existing-result) (forward-line 1))
(setq results-switches (setq results-switches
(if results-switches (concat " " results-switches) "")) (if results-switches (concat " " results-switches) ""))
@ -794,11 +957,14 @@ code ---- the results are extracted in the syntax of the source
((member "file" result-params) ((member "file" result-params)
(insert result)) (insert result))
((member "html" result-params) ((member "html" result-params)
(insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" results-switches result))) (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n"
results-switches result)))
((member "latex" result-params) ((member "latex" result-params)
(insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" results-switches result))) (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n"
results-switches result)))
((member "code" result-params) ((member "code" result-params)
(insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" lang results-switches result))) (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n"
lang results-switches result)))
((or (member "raw" result-params) (member "org" result-params)) ((or (member "raw" result-params) (member "org" result-params))
(save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) (save-excursion (insert result)) (if (org-at-table-p) (org-cycle)))
(t (t
@ -852,7 +1018,8 @@ directory then expand relative links."
(if (and default-directory (if (and default-directory
buffer-file-name buffer-file-name
(not (string= (expand-file-name default-directory) (not (string= (expand-file-name default-directory)
(expand-file-name (file-name-directory buffer-file-name))))) (expand-file-name
(file-name-directory buffer-file-name)))))
(expand-file-name result default-directory) (expand-file-name result default-directory)
result))) result)))
@ -863,7 +1030,8 @@ directory then expand relative links."
(line-number-at-pos beg))))) (line-number-at-pos beg)))))
(save-excursion (save-excursion
(cond ((= size 0) (cond ((= size 0)
(error "This should be impossible: a newline was appended to result if missing")) (error (concat "This should be impossible:"
"a newline was appended to result if missing")))
((< size org-babel-min-lines-for-block-output) ((< size org-babel-min-lines-for-block-output)
(goto-char beg) (goto-char beg)
(dotimes (n size) (dotimes (n size)
@ -882,7 +1050,8 @@ elements of PLISTS override the values of previous element. This
takes into account some special considerations for certain takes into account some special considerations for certain
parameters when merging lists." parameters when merging lists."
(let ((results-exclusive-groups (let ((results-exclusive-groups
'(("file" "vector" "table" "scalar" "raw" "org" "html" "latex" "code" "pp") '(("file" "vector" "table" "scalar" "raw" "org"
"html" "latex" "code" "pp")
("replace" "silent") ("replace" "silent")
("output" "value"))) ("output" "value")))
(exports-exclusive-groups (exports-exclusive-groups
@ -896,10 +1065,14 @@ parameters when merging lists."
(mapc (lambda (exclusive-group) (mapc (lambda (exclusive-group)
(when (member new-param exclusive-group) (when (member new-param exclusive-group)
(mapcar (lambda (excluded-param) (mapcar (lambda (excluded-param)
(setq output (delete excluded-param output))) (setq output
(delete
excluded-param
output)))
exclusive-group))) exclusive-group)))
exclusive-groups) exclusive-groups)
(setq output (org-uniquify (cons new-param output)))) (setq output (org-uniquify
(cons new-param output))))
new-params)) new-params))
result-params) result-params)
output))) output)))
@ -908,40 +1081,54 @@ parameters when merging lists."
(case (car pair) (case (car pair)
(:var (:var
;; we want only one specification per variable ;; we want only one specification per variable
(when (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=[ \t]*\\([^\f\n\r\v]+\\)$" (cdr pair)) (when (string-match
(concat "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
"[ \t]*\\([^\f\n\r\v]+\\)$") (cdr pair))
;; TODO: When is this not true? ;; TODO: When is this not true?
(setq var (intern (match-string 1 (cdr pair))) (setq var (intern (match-string 1 (cdr pair)))
ref (match-string 2 (cdr pair)) ref (match-string 2 (cdr pair))
vars (cons (cons var ref) (assq-delete-all var vars))))) vars (cons (cons var ref)
(assq-delete-all var vars)))))
(:results (:results
(setq results (setq results
(e-merge results-exclusive-groups results (split-string (cdr pair))))) (e-merge results-exclusive-groups
results (split-string (cdr pair)))))
(:file (:file
(when (cdr pair) (when (cdr pair)
(setq results (e-merge results-exclusive-groups results '("file"))) (setq results (e-merge results-exclusive-groups
results '("file")))
(unless (or (member "both" exports) (unless (or (member "both" exports)
(member "none" exports) (member "none" exports)
(member "code" 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 (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))))) exports (split-string (cdr pair)))))
(:tangle ;; take the latest -- always overwrite (:tangle ;; take the latest -- always overwrite
(setq tangle (or (list (cdr pair)) tangle))) (setq tangle (or (list (cdr pair)) tangle)))
(:noweb (:noweb
(setq noweb (e-merge '(("yes" "no")) (setq noweb
noweb (split-string (or (cdr pair) ""))))) (e-merge '(("yes" "no")) noweb
(split-string (or (cdr pair) "")))))
(:cache (:cache
(setq cache (e-merge '(("yes" "no")) (setq cache
cache (split-string (or (cdr pair) ""))))) (e-merge '(("yes" "no")) cache
(split-string (or (cdr pair) "")))))
(:shebang ;; take the latest -- always overwrite (:shebang ;; take the latest -- always overwrite
(setq shebang (or (list (cdr pair)) shebang))) (setq shebang (or (list (cdr pair)) shebang)))
(:comments (:comments
(setq comments (e-merge '(("yes" "no")) (setq comments
comments (split-string (or (cdr pair) ""))))) (e-merge '(("yes" "no")) comments
(split-string (or (cdr pair) "")))))
(t ;; replace: this covers e.g. :session (t ;; replace: this covers e.g. :session
(setq params (cons pair (assq-delete-all (car pair) params)))))) (setq params
(cons pair
(assq-delete-all (car pair) params))))))
plist)) plist))
plists)) plists))
(setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars)) (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
@ -951,8 +1138,11 @@ parameters when merging lists."
(cons (cons :cache (mapconcat 'identity cache " ")) (cons (cons :cache (mapconcat 'identity cache " "))
(cons (cons :noweb (mapconcat 'identity noweb " ")) (cons (cons :noweb (mapconcat 'identity noweb " "))
(cons (cons :tangle (mapconcat 'identity tangle " ")) (cons (cons :tangle (mapconcat 'identity tangle " "))
(cons (cons :exports (mapconcat 'identity exports " ")) (cons (cons :exports
(cons (cons :results (mapconcat 'identity results " ")) (mapconcat 'identity exports " "))
(cons
(cons :results
(mapconcat 'identity results " "))
params))))))))) params)))))))))
(defun org-babel-expand-noweb-references (&optional info parent-buffer) (defun org-babel-expand-noweb-references (&optional info parent-buffer)
@ -999,7 +1189,8 @@ block but are passed literally to the \"example-block\"."
(save-match-data (setf source-name (match-string 1))) (save-match-data (setf source-name (match-string 1)))
(save-match-data (setq evaluate (string-match "\(.*\)" source-name))) (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
(save-match-data (save-match-data
(setq prefix (buffer-substring (match-beginning 0) (setq prefix
(buffer-substring (match-beginning 0)
(save-excursion (save-excursion
(move-beginning-of-line 1) (point))))) (move-beginning-of-line 1) (point)))))
;; add interval to new-body (removing noweb reference) ;; add interval to new-body (removing noweb reference)
@ -1020,13 +1211,15 @@ block but are passed literally to the \"example-block\"."
(if point (if point
(save-excursion (save-excursion
(goto-char point) (goto-char point)
(org-babel-trim (org-babel-expand-noweb-references (org-babel-trim
(org-babel-expand-noweb-references
(org-babel-get-src-block-info)))) (org-babel-get-src-block-info))))
;; optionally raise an error if named ;; optionally raise an error if named
;; source-block doesn't exist ;; source-block doesn't exist
(if (member lang org-babel-noweb-error-langs) (if (member lang org-babel-noweb-error-langs)
(error (error
"<<%s>> could not be resolved (see `org-babel-noweb-error-langs')" (concat "<<%s>> could not be resolved "
"(see `org-babel-noweb-error-langs')")
source-name) source-name)
"")))) "[\n\r]") (concat "\n" prefix))))) "")))) "[\n\r]") (concat "\n" prefix)))))
(nb-add (buffer-substring index (point-max))))) (nb-add (buffer-substring index (point-max)))))
@ -1107,14 +1300,16 @@ the table is trivial, then return it as a scalar."
STRING. Default regexp used is \"[ \f\t\n\r\v]\" but can be STRING. Default regexp used is \"[ \f\t\n\r\v]\" but can be
overwritten by specifying a regexp as a second argument." overwritten by specifying a regexp as a second argument."
(let ((regexp (or regexp "[ \f\t\n\r\v]"))) (let ((regexp (or regexp "[ \f\t\n\r\v]")))
(while (and (> (length string) 0) (string-match regexp (substring string -1))) (while (and (> (length string) 0)
(string-match regexp (substring string -1)))
(setq string (substring string 0 -1))) (setq string (substring string 0 -1)))
string)) string))
(defun org-babel-trim (string &optional regexp) (defun org-babel-trim (string &optional regexp)
"Like `org-babel-chomp' only it runs on both the front and back of the string" "Like `org-babel-chomp' only it runs on both the front and back of the string"
(org-babel-chomp (org-babel-reverse-string (org-babel-chomp (org-babel-reverse-string
(org-babel-chomp (org-babel-reverse-string string) regexp)) regexp)) (org-babel-chomp (org-babel-reverse-string string) regexp))
regexp))
(defun org-babel-tramp-handle-call-process-region (defun org-babel-tramp-handle-call-process-region
(start end program &optional delete buffer display &rest args) (start end program &optional delete buffer display &rest args)
@ -1125,12 +1320,14 @@ Fixes a bug in `tramp-handle-call-process-region'."
(write-region start end tmpfile) (write-region start end tmpfile)
(when delete (delete-region start end)) (when delete (delete-region start end))
(unwind-protect (unwind-protect
;; (apply 'call-process program tmpfile buffer display args) ;; bug in tramp ;; (apply 'call-process program tmpfile buffer display args)
;; bug in tramp
(apply 'process-file program tmpfile buffer display args) (apply 'process-file program tmpfile buffer display args)
(delete-file tmpfile))) (delete-file tmpfile)))
;; call-process-region-original is the original emacs definition. It ;; call-process-region-original is the original emacs definition. It
;; is in scope from the let binding in org-babel-execute-src-block ;; is in scope from the let binding in org-babel-execute-src-block
(apply call-process-region-original start end program delete buffer display args))) (apply call-process-region-original
start end program delete buffer display args)))
(defun org-babel-maybe-remote-file (file) (defun org-babel-maybe-remote-file (file)
(if (file-remote-p default-directory) (if (file-remote-p default-directory)
@ -1151,12 +1348,13 @@ Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it. Return the exit code of Prefix arg means replace the region with it. Return the exit code of
COMMAND. COMMAND.
To specify a coding system for converting non-ASCII characters To specify a coding system for converting non-ASCII characters in
in the input and output to the shell command, use \\[universal-coding-system-argument] the input and output to the shell command, use
before this command. By default, the input (from the current buffer) \\[universal-coding-system-argument] before this command. By
is encoded in the same coding system that will be used to save the file, default, the input (from the current buffer) is encoded in the
`buffer-file-coding-system'. If the output is going to replace the region, same coding system that will be used to save the file,
then it is decoded from that same coding system. `buffer-file-coding-system'. If the output is going to replace
the region, then it is decoded from that same coding system.
The noninteractive arguments are START, END, COMMAND, The noninteractive arguments are START, END, COMMAND,
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
@ -1323,6 +1521,5 @@ specifies the value of ERROR-BUFFER."
(delete-file error-file)) (delete-file error-file))
exit-status)) exit-status))
(provide 'org-babel) (provide 'org-babel)
;;; org-babel.el ends here ;;; org-babel.el ends here

6
lisp/ChangeLog
View File

@ -63,6 +63,12 @@
(org-export-html-close-lists-maybe): Allow to splice raw HTML into (org-export-html-close-lists-maybe): Allow to splice raw HTML into
and out of lists. and out of lists.
2010-04-22 Dan Davison <davison@stats.ox.ac.uk>
* org-src.el (org-edit-src-code): Allow the org-src edit buffer to
be used in a read-only mode.
(org-edit-src-code): Different message in read-only mode
2010-04-21 Carsten Dominik <carsten.dominik@gmail.com> 2010-04-21 Carsten Dominik <carsten.dominik@gmail.com>
* org-src.el (org-edit-src-find-region-and-lang): Test for * org-src.el (org-edit-src-find-region-and-lang): Test for

40
lisp/org-src.el
View File

@ -187,7 +187,7 @@ This minor mode is turned on in two situations:
There is a mode hook, and keybindings for `org-edit-src-exit' and There is a mode hook, and keybindings for `org-edit-src-exit' and
`org-edit-src-save'") `org-edit-src-save'")
(defun org-edit-src-code (&optional context) (defun org-edit-src-code (&optional context code edit-buffer-name)
"Edit the source code example at point. "Edit the source code example at point.
The example is copied to a separate buffer, and that buffer is switched The example is copied to a separate buffer, and that buffer is switched
to the correct language mode. When done, exit with \\[org-edit-src-exit]. to the correct language mode. When done, exit with \\[org-edit-src-exit].
@ -200,19 +200,22 @@ the edited version. Optional argument CONTEXT is used by
(let ((line (org-current-line)) (let ((line (org-current-line))
(col (current-column)) (col (current-column))
(case-fold-search t) (case-fold-search t)
(msg (substitute-command-keys
"Edit, then exit with C-c ' (C-c and single quote)"))
(info (org-edit-src-find-region-and-lang)) (info (org-edit-src-find-region-and-lang))
(org-mode-p (eq major-mode 'org-mode)) (org-mode-p (eq major-mode 'org-mode))
(beg (make-marker)) (beg (make-marker))
(end (make-marker)) (end (make-marker))
(preserve-indentation org-src-preserve-indentation) (preserve-indentation org-src-preserve-indentation)
block-nindent total-nindent ovl lang lang-f single lfmt code begline buffer) block-nindent total-nindent ovl lang lang-f single lfmt begline buffer msg)
(if (not info) (if (not info)
nil nil
(setq beg (move-marker beg (nth 0 info)) (setq beg (move-marker beg (nth 0 info))
end (move-marker end (nth 1 info)) end (move-marker end (nth 1 info))
code (buffer-substring-no-properties beg end) allow-write-back-p (null code)
msg (if allow-write-back-p
(substitute-command-keys
"Edit, then exit with C-c ' (C-c and single quote)")
"Exit with C-c ' (C-c and single quote)")
code (or code (buffer-substring-no-properties beg end))
lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
(nth 2 info)) (nth 2 info))
lang (if (symbolp lang) (symbol-name lang) lang) lang (if (symbolp lang) (symbol-name lang) lang)
@ -241,7 +244,8 @@ the edited version. Optional argument CONTEXT is used by
(delete-overlay org-edit-src-overlay))) (delete-overlay org-edit-src-overlay)))
(kill-buffer buffer)) (kill-buffer buffer))
(setq buffer (generate-new-buffer (setq buffer (generate-new-buffer
(org-src-construct-edit-buffer-name (buffer-name) lang))) (or edit-buffer-name
(org-src-construct-edit-buffer-name (buffer-name) lang))))
(setq ovl (make-overlay beg end)) (setq ovl (make-overlay beg end))
(overlay-put ovl 'edit-buffer buffer) (overlay-put ovl 'edit-buffer buffer)
(overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
@ -264,6 +268,7 @@ the edited version. Optional argument CONTEXT is used by
(funcall lang-f)) (funcall lang-f))
(set (make-local-variable 'org-edit-src-force-single-line) single) (set (make-local-variable 'org-edit-src-force-single-line) single)
(set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
(set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p)
(set (make-local-variable 'org-src-preserve-indentation) preserve-indentation) (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation)
(when lfmt (when lfmt
(set (make-local-variable 'org-coderef-label-format) lfmt)) (set (make-local-variable 'org-coderef-label-format) lfmt))
@ -529,7 +534,7 @@ the language, a switch telling if the content should be in a single line."
(defun org-edit-src-exit (&optional context) (defun org-edit-src-exit (&optional context)
"Exit special edit and protect problematic lines." "Exit special edit and protect problematic lines."
(interactive) (interactive)
(unless org-edit-src-from-org-mode (unless (org-bound-and-true-p org-edit-src-from-org-mode)
(error "This is not a sub-editing buffer, something is wrong...")) (error "This is not a sub-editing buffer, something is wrong..."))
(widen) (widen)
(let* ((beg org-edit-src-beg-marker) (let* ((beg org-edit-src-beg-marker)
@ -541,17 +546,20 @@ the language, a switch telling if the content should be in a single line."
(total-nindent (+ (or org-edit-src-block-indentation 0) (total-nindent (+ (or org-edit-src-block-indentation 0)
org-edit-src-content-indentation)) org-edit-src-content-indentation))
(preserve-indentation org-src-preserve-indentation) (preserve-indentation org-src-preserve-indentation)
(allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p))
(delta 0) code line col indent) (delta 0) code line col indent)
(when allow-write-back-p
(unless preserve-indentation (untabify (point-min) (point-max))) (unless preserve-indentation (untabify (point-min) (point-max)))
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(if (looking-at "[ \t\n]*\n") (replace-match "")) (if (looking-at "[ \t\n]*\n") (replace-match ""))
(unless macro (unless macro
(if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))) (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))))
(setq line (if (org-bound-and-true-p org-edit-src-force-single-line) (setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
1 1
(org-current-line)) (org-current-line))
col (current-column)) col (current-column))
(when allow-write-back-p
(when single (when single
(goto-char (point-min)) (goto-char (point-min))
(if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) (if (re-search-forward "\\s-+\\'" nil t) (replace-match ""))
@ -584,14 +592,15 @@ the language, a switch telling if the content should be in a single line."
(if (org-bound-and-true-p org-edit-src-picture) (if (org-bound-and-true-p org-edit-src-picture)
(setq total-nindent (+ total-nindent 2))) (setq total-nindent (+ total-nindent 2)))
(setq code (buffer-string)) (setq code (buffer-string))
(set-buffer-modified-p nil) (set-buffer-modified-p nil))
(org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
(kill-buffer buffer) (kill-buffer buffer)
(goto-char beg) (goto-char beg)
(when allow-write-back-p
(delete-region beg end) (delete-region beg end)
(insert code) (insert code)
(goto-char beg) (goto-char beg)
(if single (just-one-space)) (if single (just-one-space)))
(if (memq t (mapcar (lambda (overlay) (if (memq t (mapcar (lambda (overlay)
(eq (overlay-get overlay 'invisible) (eq (overlay-get overlay 'invisible)
'org-hide-block)) 'org-hide-block))
@ -625,15 +634,18 @@ the language, a switch telling if the content should be in a single line."
(message (or msg "")))) (message (or msg ""))))
(defun org-src-mode-configure-edit-buffer () (defun org-src-mode-configure-edit-buffer ()
(when org-edit-src-from-org-mode (when (org-bound-and-true-p org-edit-src-from-org-mode)
(org-add-hook 'kill-buffer-hook
'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
(if (org-bound-and-true-p org-edit-src-allow-write-back-p)
(progn
(setq buffer-offer-save t) (setq buffer-offer-save t)
(setq buffer-file-name (setq buffer-file-name
(concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker))
"[" (buffer-name) "]")) "[" (buffer-name) "]"))
(set (if (featurep 'xemacs) 'write-contents-hooks 'write-contents-functions) (set (if (featurep 'xemacs) 'write-contents-hooks 'write-contents-functions)
'(org-edit-src-save)) '(org-edit-src-save)))
(org-add-hook 'kill-buffer-hook (setq buffer-read-only t))))
'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)))
(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) (org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer)