1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
| | ;;; ob-clojure-literate.el --- Clojure's Org-mode Literate Programming.
;; Authors: stardiviner <numbchild@gmail.com>
;; Package-Requires: ((emacs "24.4") (org "9") (cider "0.16.0") (dash "2.12.0"))
;; Package-Version: 1.1
;; Keywords: tools
;; homepage: https://github.com/stardiviner/ob-clojure-literate
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Auto setup ob-clojure-literate scaffold and jack-in Clojure project.
;;
;; Usage:
;;
;; [M-x ob-clojure-literate-mode] to toggle this minor mode.
;;; Code:
\f
(require 'ob-clojure)
(require 'cider)
(require 'dash)
(defgroup ob-clojure-literate nil
"Clojure's Org-mode Literate Programming."
:prefix "ob-clojure-literate-"
:group 'ob-babel)
;;;###autoload
(defcustom ob-clojure-literate-auto-jackin-p nil
"Auto jack in ob-clojure project.
Don't auto jack in by default for not rude."
:type 'boolean
:group 'ob-clojure-literate)
(defcustom ob-clojure-literate-project-location (concat user-emacs-directory "Org-mode/")
"The location for `ob-clojure-literate' scaffold project."
:type 'string
:group 'ob-clojure-literate)
(defvar ob-clojure-literate-session nil)
(defvar ob-clojure-literate-original-ns nil)
(defvar ob-clojure-literate-session-ns nil)
(defvar ob-clojure-literate-cider-connections nil)
(defcustom ob-clojure-literate-default-session "*cider-repl ob-clojure*"
"The default session name for `ob-clojure-literate'."
:type 'string
:group 'ob-clojure-literate)
(defun ob-clojure-literate-any-connection-p ()
"Return t if have any CIDER connection."
(and
;; handle the case `cider-jack-in' is not finished creating connection, but `ob-clojure-literate-mode' is enabled.
(not (null (cider-connections)))
(not (null ob-clojure-literate-session)) ; before mode enabled, it is nil.
(not (string-empty-p ob-clojure-literate-session)) ; after disable, it is "".
))
(defun ob-clojure-literate-get-session-list ()
"Return a list of available started CIDER REPL sessions list."
(-map 'buffer-name cider-connections))
(defun ob-clojure-literate-set-session ()
"Set session name for buffer local."
;; if default session is the only one in connections list.
(if (and (= (length (ob-clojure-literate-get-session-list)) 1)
(-contains-p (ob-clojure-literate-get-session-list) ob-clojure-literate-default-session))
(setq-local ob-clojure-literate-session ob-clojure-literate-default-session)
;; if have any connections, choose one from them.
(if (ob-clojure-literate-any-connection-p)
(setq-local ob-clojure-literate-session
(completing-read "Choose ob-clojure-literate :session : "
(ob-clojure-literate-get-session-list)))
;; if none, set to default session name to fix `ob-clojure-literate-mode'
;; is enabled before `cider-jack-in' generated connections.
(setq-local ob-clojure-literate-session ob-clojure-literate-default-session))
))
;;;###autoload
(defun ob-clojure-literate-specify-session-header-argument ()
"Specify ob-clojure header argument :session with value selected from a list of available sessions."
(interactive)
(let ((lang (nth 0 (org-babel-get-src-block-info))))
(if (and (string= lang "clojure") ; only in clojure src block.
(car (seq-filter ; only when :session is not specified yet.
(lambda (header-argument)
(if (eq (car header-argument) :session)
(not (null (cdr header-argument)))))
(nth 2 (org-babel-get-src-block-info)))))
(org-babel-insert-header-arg
"session"
(format "\"%s\""
(completing-read
"Choose :session for ob-clojure-literate: "
(ob-clojure-literate-get-session-list))))
(message "This function only used in `clojure' src block.")))
)
;;; Auto start CIDER REPL session in a complete Leiningen project environment for Org-mode Babel to jack-in.
;;;###autoload
(defun ob-clojure-literate-auto-jackin ()
"Auto setup ob-clojure-literate scaffold and jack-in Clojure project."
(interactive)
(unless (file-directory-p (expand-file-name ob-clojure-literate-project-location))
(make-directory ob-clojure-literate-project-location t)
(let ((default-directory ob-clojure-literate-project-location))
(shell-command "lein new ob-clojure")))
(unless (or
(and (cider-connected-p)
(if (not (null ob-clojure-literate-session))
(seq-contains cider-connections (get-buffer ob-clojure-literate-session))))
cider-connections
(not (null ob-clojure-literate-session)))
;; return back to original file.
(if (not (and (= (length (ob-clojure-literate-get-session-list)) 1)
(-contains-p (ob-clojure-literate-get-session-list) ob-clojure-literate-default-session)))
(save-window-excursion
(find-file (expand-file-name (concat ob-clojure-literate-project-location "ob-clojure/src/ob_clojure/core.clj")))
(with-current-buffer "core.clj"
(cider-jack-in))))))
(defun ob-clojure-literate-set-local-cider-connections (toggle?)
"Set buffer local `cider-connections' for `ob-clojure-literate-mode' `TOGGLE?'."
(if toggle?
(progn
(setq ob-clojure-literate-cider-connections cider-connections)
(unless (local-variable-if-set-p 'cider-connections)
(make-local-variable 'cider-connections))
(setq-local cider-connections ob-clojure-literate-cider-connections))
;; store/restore emptied CIDER connections by `ob-clojure-literate-enable'.
(kill-local-variable 'cider-connections) ; kill local variable so that I can get the original global variable value.
;; Empty all CIDER connections to avoid `cider-current-connection' return any connection.
;; FIXME: when try to enable, `cider-connections' is local and nil.
;; (if (and (= (length (ob-clojure-literate-get-session-list)) 1)
;; (-contains-p (ob-clojure-literate-get-session-list) ob-clojure-literate-default-session)))
;; (unless (local-variable-if-set-p 'cider-connections)
;; (make-local-variable 'cider-connections))
;; (setq-local cider-connections '())
))
(defun ob-clojure-literate-cider-do-not-find-ns (body params)
"Fix the issue that `cider-current-ns' try to invoke `clojure-find-ns' to extract ns from buffer."
;; TODO: Is it possible to find ns in `body'?
(when (ob-clojure-literate-any-connection-p)
(setq ob-clojure-literate-original-ns (cider-current-ns))
(with-current-buffer ob-clojure-literate-session
(setq ob-clojure-literate-session-ns cider-buffer-ns))
(setq-local cider-buffer-ns ob-clojure-literate-session-ns))
(message (format "ob-clojure-literate: current CIDER ns is [%s]." cider-buffer-ns)))
(defun ob-clojure-literate-set-local-session (toggle?)
"Set buffer local `org-babel-default-header-args:clojure' for `ob-clojure-literate-mode' `TOGGLE?'."
(if toggle?
(progn
;; set local default session for ob-clojure.
(setq ob-clojure-literate-session (ob-clojure-literate-set-session))
(unless (local-variable-if-set-p 'org-babel-default-header-args:clojure)
(make-local-variable 'org-babel-default-header-args:clojure))
(add-to-list 'org-babel-default-header-args:clojure
`(:session . ,ob-clojure-literate-session))
)
;; remove :session from buffer local default header arguments list.
(unless (local-variable-if-set-p 'org-babel-default-header-args:clojure)
(make-local-variable 'org-babel-default-header-args:clojure))
(setq org-babel-default-header-args:clojure
(delq t
(mapcar
(lambda (cons) (if (eq (car cons) :session) t cons))
org-babel-default-header-args:clojure)))
))
;;; Support `org-babel-initiate-session' / [C-c C-v z] to initialize Clojure session.
(defun org-babel-clojure-initiate-session (&optional session _params)
"Initiate a session named SESSION according to PARAMS."
(when (and session (not (string= session "none")))
(save-window-excursion
(unless (org-babel-comint-buffer-livep session)
;; CIDER jack-in to the Clojure project directory.
(cond
((eq org-babel-clojure-backend 'cider)
(require 'cider)
(let ((session-buffer (save-window-excursion
(cider-jack-in t)
(current-buffer))))
(if (org-babel-comint-buffer-livep session-buffer)
(progn (sit-for .25) session-buffer))))
((eq org-babel-clojure-backend 'slime)
(error "Session evaluation with SLIME is not supported"))
(t
(error "Session initiate failed")))
)
(get-buffer session)
)))
(defun org-babel-prep-session:clojure (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-clojure-initiate-session session))
(var-lines (org-babel-variable-assignments:clojure params)))
(when session
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1) (goto-char (point-max))) var-lines)))
session))
(defun org-babel-clojure-var-to-clojure (var)
"Convert src block's `VAR' to Clojure variable."
;; TODO: reference `org-babel-python-var-to-python'
)
(defun org-babel-variable-assignments:clojure (params)
"Return a list of Clojure statements assigning the block's variables in `PARAMS'."
(mapcar
(lambda (pair)
(format "(def %s %s)"
(car pair)
;; (org-babel-clojure-var-to-clojure (cdr pair))
(cdr pair)))
(org-babel--get-vars params)))
;;; Support header arguments :results graphics :file "image.png" by inject Clojure code.
(defun ob-clojure-literate-inject-code (args)
"Inject Clojure code into `BODY' in `ARGS'.
It is used to change Clojure currently working directory in a FAKE way.
And generate inline graphics image file link result.
Use header argument like this:
:results graphics :file \"incanter-plot.png\"
Then you need to assign image variable to this :file value like:
(def incanter-plot (histogram (sample-normal 1000)))
*NOTE*: Currently only support Incanter's `save' function.
"
(let* ((body (nth 0 args))
(params (nth 1 args))
(dir (cdr (assq :dir params)))
(default-directory (and (buffer-file-name) (file-name-directory (buffer-file-name))))
(directory (and dir (file-name-as-directory (expand-file-name dir))))
(result-type (cdr (assq :results params)))
(file (cdr (assq :file params)))
(file-name (file-name-base file))
;; TODO: future support `:graphics-file' to avoid collision.
(graphics-result (member "graphics" (cdr (assq :result-params params))))
;; (graphics-file (cdr (assq :graphics-file params)))
;; (graphics-name (file-name-base graphics-file))
(prepend-to-body (lambda (code)
(setq body (concat code "\n" body))))
(append-to-body (lambda (code)
(setq body (concat body "\n" code "\n"))))
)
(when directory
(unless (file-directory-p (expand-file-name directory))
(warn (format "Target directory %s does not exist, please create it." dir))))
(when file
(funcall append-to-body
(format "(save %s \"%s\")" file-name (concat directory file)))
)
(list body params) ; return modified argument list
))
;;; support :results graphics :dir "data/image" :file "incanter-plot.png"
(defun ob-clojure-literate-support-graphics-result (result)
"Support :results graphics :dir \"data/images\" :file \"incanter-plot.png\"
reset `RESULT' to `nil'."
(let* ((params (nth 2 info))
(graphics-result (member "graphics" (cdr (assq :result-params params)))))
(if graphics-result
(setq result nil))
result))
(defvar ob-clojure-literate-mode-map
(let ((map (make-sparse-keymap)))
map)
"Keymap for `ob-clojure-literate-mode'.")
(define-key org-babel-map (kbd "M-s") 'ob-clojure-literate-specify-session-header-argument)
(define-key org-babel-map (kbd "M-j") 'ob-clojure-literate-auto-jackin)
;; (define-key org-babel-map (kbd "M-e") 'cider-eval-last-sexp)
;; (define-key org-babel-map (kbd "M-d") 'cider-doc)
;;;###autoload
(defun ob-clojure-literate-enable ()
"Enable Org-mode buffer locally for `ob-clojure-literate'."
(when (and (not (null cider-connections)) ; only enable `ob-clojure-literate-mode' when has CIDER connections.
(equal major-mode 'org-mode)) ; `ob-clojure-literate-mode' only works in `org-mode'.
(ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
(ob-clojure-literate-set-local-session ob-clojure-literate-mode)
(advice-add 'org-babel-execute:clojure :before #'ob-clojure-literate-cider-do-not-find-ns)
(advice-add 'org-babel-expand-body:clojure :filter-args #'ob-clojure-literate-inject-code)
(advice-add 'org-babel-execute:clojure :filter-return #'ob-clojure-literate-support-graphics-result)
(message "ob-clojure-literate minor mode enabled.")))
;;;###autoload
(defun ob-clojure-literate-disable ()
"Disable Org-mode buffer locally for `ob-clojure-literate'."
(advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-cider-do-not-find-ns)
(advice-remove 'org-babel-expand-body:clojure #'ob-clojure-literate-inject-code)
(advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-support-graphics-result)
(setq-local cider-buffer-ns ob-clojure-literate-original-ns)
(ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
(ob-clojure-literate-set-local-session ob-clojure-literate-mode)
(message "ob-clojure-literate minor mode disabled."))
;;;###autoload
(if ob-clojure-literate-auto-jackin-p (ob-clojure-literate-auto-jackin))
;;;###autoload
(define-minor-mode ob-clojure-literate-mode
"A minor mode to toggle `ob-clojure-literate'."
:require 'ob-clojure-literate
:init-value t
:lighter " clj-lp"
:group 'ob-clojure-literate
:keymap ob-clojure-literate-mode-map
:global nil
(if ob-clojure-literate-mode
(ob-clojure-literate-enable)
(ob-clojure-literate-disable))
)
\f
(provide 'ob-clojure-literate)
;;; ob-clojure-literate.el ends here
|