1 ;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
5 ;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
7 ;; Keywords: literate programming, reproducible research
8 ;; Homepage: https://orgmode.org
10 ;; This file is part of GNU Emacs.
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
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
27 ;; Support for evaluating clojure code
31 ;; - clojure (at least 1.2.0)
33 ;; - either cider or SLIME
35 ;; For Cider, see https://github.com/clojure-emacs/cider
37 ;; For SLIME, the best way to install these components is by following
38 ;; the directions as set out by Phil Hagelberg (Technomancy) on the
39 ;; web page: http://technomancy.us/126
46 (declare-function cider-current-connection
"ext:cider-client" (&optional type
))
47 (declare-function cider-current-ns
"ext:cider-client" ())
48 (declare-function nrepl--merge
"ext:nrepl-client" (dict1 dict2
))
49 (declare-function nrepl-dict-get
"ext:nrepl-client" (dict key
))
50 (declare-function nrepl-dict-put
"ext:nrepl-client" (dict key value
))
51 (declare-function nrepl-request
:eval
"ext:nrepl-client" (input callback connection
&optional ns line column additional-params tooling
))
52 (declare-function nrepl-sync-request
:eval
"ext:nrepl-client" (input connection
&optional ns tooling
))
53 (declare-function slime-eval
"ext:slime" (sexp &optional package
))
55 (defvar nrepl-sync-request-timeout
)
56 (defvar cider-buffer-ns
)
58 (defvar org-babel-tangle-lang-exts
)
59 (add-to-list 'org-babel-tangle-lang-exts
'("clojure" .
"clj"))
61 (defvar org-babel-default-header-args
:clojure
'())
62 (defvar org-babel-header-args
:clojure
'((package .
:any
)))
64 (defcustom org-babel-clojure-sync-nrepl-timeout
10
65 "Timeout value, in seconds, of a Clojure sync call.
66 If the value is nil, timeout is disabled."
70 :package-version
'(Org .
"9.1")
73 (defcustom org-babel-clojure-backend
74 (cond ((featurep 'cider
) 'cider
)
76 "Backend used to evaluate Clojure code blocks."
79 (const :tag
"cider" cider
)
80 (const :tag
"SLIME" slime
)))
82 (defcustom org-babel-clojure-default-ns
"user"
83 "Default Clojure namespace for src block when all find ns ways failed."
87 (defun org-babel-clojure-cider-current-ns ()
88 "Like `cider-current-ns' except `cider-find-ns'."
90 (let ((repl-buf (cider-current-connection)))
91 (and repl-buf
(buffer-local-value 'cider-buffer-ns repl-buf
)))
92 org-babel-clojure-default-ns
))
94 (defun org-babel-expand-body:clojure
(body params
)
95 "Expand BODY according to PARAMS, return the expanded body."
96 (let* ((vars (org-babel--get-vars params
))
97 (ns (or (cdr (assq :ns params
))
98 (org-babel-clojure-cider-current-ns)))
99 (result-params (cdr (assq :result-params params
)))
104 (format "(ns %s)\n%s"
105 ;; Source block specified namespace :ns.
107 ;; Variables binding.
108 (if (null vars
) (org-trim body
)
109 (format "(let [%s]\n%s)"
112 (format "%S (quote %S)" (car var
) (cdr var
)))
116 (if (or (member "code" result-params
)
117 (member "pp" result-params
))
118 (format "(clojure.pprint/pprint (do %s))" body
)
121 (defun org-babel-execute:clojure
(body params
)
122 "Execute a block of Clojure code with Babel.
123 The underlying process performed by the code block can be output
124 using the :show-process parameter."
125 (let* ((expanded (org-babel-expand-body:clojure body params
))
126 (response (list 'dict
))
128 (cl-case org-babel-clojure-backend
131 (let ((result-params (cdr (assq :result-params params
)))
132 (show (cdr (assq :show-process params
))))
133 (if (member show
'(nil "no"))
134 ;; Run code without showing the process.
137 (let ((nrepl-sync-request-timeout
138 org-babel-clojure-sync-nrepl-timeout
))
139 (nrepl-sync-request:eval expanded
140 (cider-current-connection))))
143 (nrepl-dict-get response
144 (if (or (member "output" result-params
)
145 (member "pp" result-params
))
148 (nrepl-dict-get response
"ex")
149 (nrepl-dict-get response
"root-ex")
150 (nrepl-dict-get response
"err"))))
151 ;; Show the process in an output buffer/window.
152 (let ((process-buffer (switch-to-buffer-other-window
153 "*Clojure Show Process Sub Buffer*"))
155 ;; Run the Clojure code in nREPL.
159 (when (member "out" resp
)
160 ;; Print the output of the nREPL in the output buffer.
161 (princ (nrepl-dict-get resp
"out") process-buffer
))
162 (when (member "ex" resp
)
163 ;; In case there is an exception, then add it to the
164 ;; output buffer as well.
165 (princ (nrepl-dict-get resp
"ex") process-buffer
)
166 (princ (nrepl-dict-get resp
"root-ex") process-buffer
))
167 (when (member "err" resp
)
168 ;; In case there is an error, then add it to the
169 ;; output buffer as well.
170 (princ (nrepl-dict-get resp
"err") process-buffer
))
171 (nrepl--merge response resp
)
172 ;; Update the status of the nREPL output session.
173 (setq status
(nrepl-dict-get response
"status")))
174 (cider-current-connection))
176 ;; Wait until the nREPL code finished to be processed.
177 (while (not (member "done" status
))
178 (nrepl-dict-put response
"status" (remove "need-input" status
))
179 (accept-process-output nil
0.01)
182 ;; Delete the show buffer & window when the processing is
184 (mapc #'delete-window
185 (get-buffer-window-list process-buffer nil t
))
186 (kill-buffer process-buffer
)
188 ;; Put the output or the value in the result section of
192 (nrepl-dict-get response
193 (if (or (member "output" result-params
)
194 (member "pp" result-params
))
197 (nrepl-dict-get response
"ex")
198 (nrepl-dict-get response
"root-ex")
199 (nrepl-dict-get response
"err")))))))
206 `(swank:eval-and-grab-output
207 ,(buffer-substring-no-properties (point-min) (point-max)))
208 (cdr (assq :package params
)))))))
209 (org-babel-result-cond (cdr (assq :result-params params
))
211 (condition-case nil
(org-babel-script-escape result
)
214 (provide 'ob-clojure
)
216 ;;; ob-clojure.el ends here