Mercurial > emacs

comparison lisp/org/ob-clojure.el @ 111880:a7740098b594

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Update to Org mode 7.4
author Carsten Dominik <carsten.dominik@gmail.com>
date Sat, 11 Dec 2010 17:42:53 +0100
parents 5cb272c831e8
children 6378d1b57038
comparison
equal deleted inserted replaced
111879:4a0faa1cecc2 111880:a7740098b594
1 ;;; ob-clojure.el --- org-babel functions for clojure evaluation 1 ;;; ob-clojure.el --- org-babel functions for clojure evaluation
2 2
3 ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. 3 ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
4 4
5 ;; Author: Joel Boehland 5 ;; Author: Joel Boehland, Eric Schulte
6 ;; Keywords: literate programming, reproducible research 6 ;; Keywords: literate programming, reproducible research
7 ;; Homepage: http://orgmode.org 7 ;; Homepage: http://orgmode.org
8 ;; Version: 7.3 8 ;; Version: 7.4
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by 13 ;; it under the terms of the GNU General Public License as published by
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 24
25 ;;; Commentary: 25 ;;; Commentary:
26 26
27 ;;; ob support for evaluating clojure code 27 ;;; support for evaluating clojure code, relies on slime for all eval
28 28
29 ;;; Requirements: 29 ;;; Requirements:
30 30
31 ;;; A working clojure install. This also implies a working java executable 31 ;;; - clojure (at least 1.2.0)
32 ;;; clojure-mode 32 ;;; - clojure-mode
33 ;;; slime 33 ;;; - slime
34 ;;; swank-clojure 34 ;;; - swank-clojure
35 35
36 ;;; By far, the best way to install these components is by following 36 ;;; By far, the best way to install these components is by following
37 ;;; the directions as set out by Phil Hagelberg (Technomancy) on the 37 ;;; the directions as set out by Phil Hagelberg (Technomancy) on the
38 ;;; web page: http://technomancy.us/126 38 ;;; web page: http://technomancy.us/126
39 39
40 ;;; Code: 40 ;;; Code:
41 (require 'ob) 41 (require 'ob)
42 (require 'ob-eval)
43 (eval-when-compile (require 'cl))
44 42
45 (declare-function slime-eval-async "ext:slime" (sexp &optional cont package))
46 (declare-function slime-eval "ext:slime" (sexp &optional package)) 43 (declare-function slime-eval "ext:slime" (sexp &optional package))
47 (declare-function swank-clojure-concat-paths "ext:slime" (paths))
48 (declare-function slime "ext:slime" (&optional command coding-system))
49 (declare-function slime-output-buffer "ext:slime" (&optional noprompt))
50 (declare-function slime-filter-buffers "ext:slime" (predicate))
51 44
52 (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) 45 (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
53 46
54 (defvar org-babel-default-header-args:clojure '()) 47 (defvar org-babel-default-header-args:clojure '())
55 48 (defvar org-babel-header-arg-names:clojure '(package))
56 (defvar org-babel-clojure-wrapper-method
57 "
58 (defn spit
59 [f content]
60 (with-open [#^java.io.PrintWriter w
61 (java.io.PrintWriter.
62 (java.io.BufferedWriter.
63 (java.io.OutputStreamWriter.
64 (java.io.FileOutputStream.
65 (java.io.File. f)))))]
66 (.print w content)))
67
68 (defn main
69 []
70 %s)
71
72 (spit \"%s\" (str (main)))")
73 ;;";; <-- syntax highlighting is messed without this double quote
74
75 ;;taken mostly from clojure-test-mode.el
76 (defun org-babel-clojure-clojure-slime-eval (string &optional handler)
77 "Evaluate a STRING of clojure code using `slime-eval-async'."
78 (slime-eval-async `(swank:eval-and-grab-output ,string)
79 (or handler #'identity)))
80
81 (defun org-babel-clojure-slime-eval-sync (string)
82 "Evaluate a STRING of clojure code using `slime-eval'."
83 (slime-eval `(swank:eval-and-grab-output ,string)))
84
85 ;;taken from swank-clojure.el
86 (defvar swank-clojure-binary)
87 (defvar swank-clojure-classpath)
88 (defvar swank-clojure-java-path)
89 (defvar swank-clojure-extra-vm-args)
90 (defvar swank-clojure-library-paths)
91 (defvar swank-clojure-extra-classpaths)
92 (defun org-babel-clojure-babel-clojure-cmd ()
93 "Create the command to start clojure according to current settings."
94 (or (when swank-clojure-binary
95 (if (listp swank-clojure-binary)
96 swank-clojure-binary
97 (list swank-clojure-binary)))
98 (when swank-clojure-classpath
99 (delq
100 nil
101 (append
102 (list swank-clojure-java-path)
103 swank-clojure-extra-vm-args
104 (list
105 (when swank-clojure-library-paths
106 (concat "-Djava.library.path="
107 (swank-clojure-concat-paths swank-clojure-library-paths)))
108 "-classpath"
109 (swank-clojure-concat-paths
110 (append
111 swank-clojure-classpath
112 swank-clojure-extra-classpaths))
113 "clojure.main"))))
114 (error "%s" (concat "You must specifiy either a `swank-clojure-binary' "
115 "or a `swank-clojure-classpath'"))))
116
117 (defun org-babel-clojure-table-or-string (results)
118 "Convert RESULTS to an elisp value.
119 If RESULTS looks like a table, then convert to an Emacs-lisp
120 table, otherwise return the results as a string."
121 (org-babel-read
122 (if (string-match "^\\[.+\\]$" results)
123 (org-babel-read
124 (concat "'"
125 (replace-regexp-in-string
126 "\\[" "(" (replace-regexp-in-string
127 "\\]" ")" (replace-regexp-in-string
128 ", " " " (replace-regexp-in-string
129 "'" "\"" results))))))
130 results)))
131
132 (defun org-babel-clojure-var-to-clojure (var)
133 "Convert an elisp value into a clojure variable.
134 The elisp value VAR is converted into a string of clojure source
135 code specifying a variable of the same value."
136 (if (listp var)
137 (format "'%s" var)
138 (format "%S" var)))
139
140 (defun org-babel-clojure-build-full-form (body vars)
141 "Construct a clojure let form with VARS as the let variables."
142 (let ((vars-forms
143 (mapconcat ;; define any variables
144 (lambda (pair)
145 (format "%s %s"
146 (car pair) (org-babel-clojure-var-to-clojure (cdr pair))))
147 vars "\n "))
148 (body (org-babel-trim body)))
149 (if (> (length vars-forms) 0)
150 (format "(let [%s]\n %s)" vars-forms body)
151 body)))
152
153 (defun org-babel-prep-session:clojure (session params)
154 "Prepare SESSION according to the header arguments specified in PARAMS."
155 (require 'slime) (require 'swank-clojure)
156 (let* ((session-buf (org-babel-clojure-initiate-session session))
157 (vars (mapcar #'cdr (org-babel-get-header params :var)))
158 (var-lines (mapcar ;; define any top level session variables
159 (lambda (pair)
160 (format "(def %s %s)\n" (car pair)
161 (org-babel-clojure-var-to-clojure (cdr pair))))
162 vars)))
163 session-buf))
164
165 (defun org-babel-load-session:clojure (session body params)
166 "Load BODY into SESSION."
167 (require 'slime) (require 'swank-clojure)
168 (save-window-excursion
169 (let ((buffer (org-babel-prep-session:clojure session params)))
170 (with-current-buffer buffer
171 (goto-char (point-max))
172 (insert (org-babel-chomp body)))
173 buffer)))
174
175 (defvar org-babel-clojure-buffers '())
176 (defvar org-babel-clojure-pending-sessions '())
177
178 (defun org-babel-clojure-session-buffer (session)
179 "Return the buffer associated with SESSION."
180 (cdr (assoc session org-babel-clojure-buffers)))
181
182 (defun org-babel-clojure-initiate-session-by-key (&optional session)
183 "Initiate a clojure session in an inferior-process-buffer.
184 If there is not a current inferior-process-buffer in SESSION
185 then create one. Return the initialized session."
186 (save-window-excursion
187 (let* ((session (if session
188 (if (stringp session) (intern session)
189 session)
190 :default))
191 (clojure-buffer (org-babel-clojure-session-buffer session)))
192 (unless (and clojure-buffer (buffer-live-p clojure-buffer))
193 (setq org-babel-clojure-buffers
194 (assq-delete-all session org-babel-clojure-buffers))
195 (push session org-babel-clojure-pending-sessions)
196 (slime)
197 ;; we are waiting to finish setting up which will be done in
198 ;; org-babel-clojure-session-connected-hook below.
199 (let ((timeout 9))
200 (while (and (not (org-babel-clojure-session-buffer session))
201 (< 0 timeout))
202 (message "Waiting for clojure repl for session: %s ... %i"
203 session timeout)
204 (sit-for 1)
205 (decf timeout)))
206 (setq org-babel-clojure-pending-sessions
207 (remove session org-babel-clojure-pending-sessions))
208 (unless (org-babel-clojure-session-buffer session)
209 (error "Couldn't create slime clojure process"))
210 (setq clojure-buffer (org-babel-clojure-session-buffer session)))
211 session)))
212
213 (defun org-babel-clojure-initiate-session (&optional session params)
214 "Return the slime-clojure repl buffer bound to SESSION.
215 Returns nil if \"none\" is specified."
216 (require 'slime) (require 'swank-clojure)
217 (unless (and (stringp session) (string= session "none"))
218 (org-babel-clojure-session-buffer
219 (org-babel-clojure-initiate-session-by-key session))))
220
221 (defun org-babel-clojure-session-connected-hook ()
222 "Finish binding an org-babel session to a slime-clojure repl."
223 (let ((pending-session (pop org-babel-clojure-pending-sessions)))
224 (when pending-session
225 (save-excursion
226 (switch-to-buffer (slime-output-buffer))
227 (rename-buffer
228 (if (stringp pending-session)
229 pending-session (symbol-name pending-session)))
230 (org-babel-clojure-bind-session-to-repl-buffer
231 pending-session (slime-output-buffer))))))
232
233 (add-hook 'slime-connected-hook 'org-babel-clojure-session-connected-hook)
234
235 (defun org-babel-clojure-bind-session-to-repl-buffer (session repl-buffer)
236 "Associate SESSION with REPL-BUFFER."
237 (when (stringp session) (setq session (intern session)))
238 (setq org-babel-clojure-buffers
239 (cons (cons session repl-buffer)
240 (assq-delete-all session org-babel-clojure-buffers))))
241
242 (defun org-babel-clojure-repl-buffer-pred ()
243 "Test whether the current buffer is an active slime-clojure
244 repl buffer."
245 (and (buffer-live-p (current-buffer)) (eq major-mode 'slime-repl-mode)))
246
247 (defun org-babel-clojure-bind-session-to-repl (session)
248 "Bind SESSION to a clojure repl."
249 (interactive "sEnter session name: ")
250 (let ((repl-bufs (slime-filter-buffers 'org-babel-clojure-repl-buffer-pred)))
251 (unless repl-bufs (error "No existing slime-clojure repl buffers exist"))
252 (let ((repl-buf (read-buffer "Choose slime-clojure repl: " repl-bufs t)))
253 (org-babel-clojure-bind-session-to-repl-buffer session repl-buf))))
254
255 (defun org-babel-clojure-evaluate-external-process
256 (buffer body &optional result-type)
257 "Evaluate the body in an external process."
258 (let ((cmd (format "%s -" (mapconcat #'identity
259 (org-babel-clojure-babel-clojure-cmd)
260 " "))))
261 (case result-type
262 (output (org-babel-eval cmd body))
263 (value (let* ((tmp-file (org-babel-temp-file "clojure-")))
264 (org-babel-eval
265 cmd
266 (format
267 org-babel-clojure-wrapper-method
268 body
269 (org-babel-process-file-name tmp-file 'noquote)))
270 (org-babel-clojure-table-or-string
271 (org-babel-eval-read-file tmp-file)))))))
272
273 (defun org-babel-clojure-evaluate-session (buffer body &optional result-type)
274 "Evaluate the body in the context of a clojure session."
275 (require 'slime) (require 'swank-clojure)
276 (let ((raw nil)
277 (results nil))
278 (with-current-buffer buffer
279 (setq raw (org-babel-clojure-slime-eval-sync body))
280 (setq results (reverse (mapcar #'org-babel-trim raw)))
281 (cond
282 ((equal result-type 'output)
283 (mapconcat #'identity (reverse (cdr results)) "\n"))
284 ((equal result-type 'value)
285 (org-babel-clojure-table-or-string (car results)))))))
286
287 (defun org-babel-clojure-evaluate (buffer body &optional result-type)
288 "Pass BODY to the Clojure process in BUFFER.
289 If RESULT-TYPE equals 'output then return a list of the outputs
290 of the statements in BODY, if RESULT-TYPE equals 'value then
291 return the value of the last statement in BODY as elisp."
292 (if buffer
293 (org-babel-clojure-evaluate-session buffer body result-type)
294 (org-babel-clojure-evaluate-external-process buffer body result-type)))
295 49
296 (defun org-babel-expand-body:clojure (body params) 50 (defun org-babel-expand-body:clojure (body params)
297 "Expand BODY according to PARAMS, return the expanded body." 51 "Expand BODY according to PARAMS, return the expanded body."
298 (org-babel-clojure-build-full-form 52 (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
299 body (mapcar #'cdr (org-babel-get-header params :var)))) 53 (result-params (cdr (assoc :result-params params)))
54 (print-level nil) (print-length nil)
55 (body (org-babel-trim
56 (if (> (length vars) 0)
57 (concat "(let ["
58 (mapconcat
59 (lambda (var)
60 (format "%S (quote %S)" (car var) (cdr var)))
61 vars "\n ")
62 "]\n" body ")")
63 body))))
64 (if (or (member "code" result-params)
65 (member "pp" result-params))
66 (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)]"
67 "(clojure.pprint/with-pprint-dispatch %s-dispatch"
68 "(clojure.pprint/pprint %s org-mode-print-catcher)"
69 "(str org-mode-print-catcher)))")
70 (if (member "code" result-params) "code" "simple") body)
71 body)))
300 72
301 (defun org-babel-execute:clojure (body params) 73 (defun org-babel-execute:clojure (body params)
302 "Execute a block of Clojure code." 74 "Execute a block of Clojure code with Babel."
303 (require 'slime) (require 'swank-clojure) 75 (require 'slime) (require 'swank-clojure)
304 (let* ((body (org-babel-expand-body:clojure body params)) 76 (with-temp-buffer
305 (session (org-babel-clojure-initiate-session 77 (insert (org-babel-expand-body:clojure body params))
306 (cdr (assoc :session params))))) 78 (read
307 (org-babel-reassemble-table 79 (slime-eval
308 (org-babel-clojure-evaluate session body (cdr (assoc :result-type params))) 80 `(swank:interactive-eval-region
309 (org-babel-pick-name 81 ,(buffer-substring-no-properties (point-min) (point-max)))
310 (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) 82 (cdr (assoc :package params))))))
311 (org-babel-pick-name
312 (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
313 83
314 (provide 'ob-clojure) 84 (provide 'ob-clojure)
315 85
316 ;; arch-tag: a43b33f2-653e-46b1-ac56-2805cf05b7d1 86 ;; arch-tag: a43b33f2-653e-46b1-ac56-2805cf05b7d1
317 87