.emacs.d.git - Gitblit

Chizi123

2018-11-21 e75a20334813452c6912c090d70a0de2c805f94d

commit \| author \| age
76bbd0	1	;;; ob-clojure.el --- Babel Functions for Clojure -- lexical-binding: t; --
C	2
	3	;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
	4
	5	;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
	6	;;
	7	;; Keywords: literate programming, reproducible research
	8	;; Homepage: https://orgmode.org
	9
	10	;; This file is part of GNU Emacs.
	11
	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.
	16
	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.
	21
	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/>.
	24
	25	;;; Commentary:
	26
	27	;; Support for evaluating clojure code
	28
	29	;; Requirements:
	30
	31	;; - clojure (at least 1.2.0)
	32	;; - clojure-mode
	33	;; - either cider or SLIME
	34
	35	;; For Cider, see https://github.com/clojure-emacs/cider
	36
	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
	40
	41	;;; Code:
	42	(require 'cl-lib)
	43	(require 'ob)
	44
	45	(declare-function cider-current-connection "ext:cider-client" (&optional type))
	46	(declare-function cider-current-ns "ext:cider-client" ())
	47	(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2))
	48	(declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
	49	(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value))
	50	(declare-function nrepl-request:eval "ext:nrepl-client"
	51	(input callback connection &optional session ns line column additional-params))
	52	(declare-function nrepl-sync-request:eval "ext:nrepl-client"
	53	(input connection session &optional ns))
	54	(declare-function org-trim "org" (s &optional keep-lead))
	55	(declare-function slime-eval "ext:slime" (sexp &optional package))
	56
	57	(defvar nrepl-sync-request-timeout)
	58
	59	(defvar org-babel-tangle-lang-exts)
	60	(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
	61
	62	(defvar org-babel-default-header-args:clojure '())
	63	(defvar org-babel-header-args:clojure '((package . :any)))
	64
	65	(defcustom org-babel-clojure-sync-nrepl-timeout 10
	66	"Timeout value, in seconds, of a Clojure sync call.
	67	If the value is nil, timeout is disabled."
	68	:group 'org-babel
	69	:type 'integer
	70	:version "26.1"
	71	:package-version '(Org . "9.1")
	72	:safe #'wholenump)
	73
	74	(defcustom org-babel-clojure-backend
	75	(cond ((featurep 'cider) 'cider)
	76	(t 'slime))
	77	"Backend used to evaluate Clojure code blocks."
	78	:group 'org-babel
	79	:type '(choice
	80	(const :tag "cider" cider)
	81	(const :tag "SLIME" slime)))
	82
	83	(defun org-babel-expand-body:clojure (body params)
	84	"Expand BODY according to PARAMS, return the expanded body."
	85	(let* ((vars (org-babel--get-vars params))
	86	(result-params (cdr (assq :result-params params)))
	87	(print-level nil) (print-length nil)
	88	(body (org-trim
	89	(if (null vars) (org-trim body)
	90	(concat "(let ["
	91	(mapconcat
	92	(lambda (var)
	93	(format "%S (quote %S)" (car var) (cdr var)))
	94	vars "\n ")
	95	"]\n" body ")")))))
	96	(if (or (member "code" result-params)
	97	(member "pp" result-params))
	98	(format "(clojure.pprint/pprint (do %s))" body)
	99	body)))
	100
	101	(defun org-babel-execute:clojure (body params)
	102	"Execute a block of Clojure code with Babel.
	103	The underlying process performed by the code block can be output
	104	using the :show-process parameter."
	105	(let ((expanded (org-babel-expand-body:clojure body params))
	106	(response (list 'dict))
	107	result)
	108	(cl-case org-babel-clojure-backend
	109	(cider
	110	(require 'cider)
	111	(let ((result-params (cdr (assq :result-params params)))
	112	(show (cdr (assq :show-process params))))
	113	(if (member show '(nil "no"))
	114	;; Run code without showing the process.
	115	(progn
	116	(setq response
	117	(let ((nrepl-sync-request-timeout
	118	org-babel-clojure-sync-nrepl-timeout))
	119	(nrepl-sync-request:eval expanded
	120	(cider-current-connection)
	121	(cider-current-ns))))
	122	(setq result
	123	(concat
	124	(nrepl-dict-get response
	125	(if (or (member "output" result-params)
	126	(member "pp" result-params))
	127	"out"
	128	"value"))
	129	(nrepl-dict-get response "ex")
	130	(nrepl-dict-get response "root-ex")
	131	(nrepl-dict-get response "err"))))
	132	;; Show the process in an output buffer/window.
	133	(let ((process-buffer (switch-to-buffer-other-window
	134	"Clojure Show Process Sub Buffer"))
	135	status)
	136	;; Run the Clojure code in nREPL.
	137	(nrepl-request:eval
	138	expanded
	139	(lambda (resp)
	140	(when (member "out" resp)
	141	;; Print the output of the nREPL in the output buffer.
	142	(princ (nrepl-dict-get resp "out") process-buffer))
	143	(when (member "ex" resp)
	144	;; In case there is an exception, then add it to the
	145	;; output buffer as well.
	146	(princ (nrepl-dict-get resp "ex") process-buffer)
	147	(princ (nrepl-dict-get resp "root-ex") process-buffer))
	148	(when (member "err" resp)
	149	;; In case there is an error, then add it to the
	150	;; output buffer as well.
	151	(princ (nrepl-dict-get resp "err") process-buffer))
	152	(nrepl--merge response resp)
	153	;; Update the status of the nREPL output session.
	154	(setq status (nrepl-dict-get response "status")))
	155	(cider-current-connection)
	156	(cider-current-ns))
	157
	158	;; Wait until the nREPL code finished to be processed.
	159	(while (not (member "done" status))
	160	(nrepl-dict-put response "status" (remove "need-input" status))
	161	(accept-process-output nil 0.01)
	162	(redisplay))
	163
	164	;; Delete the show buffer & window when the processing is
	165	;; finalized.
	166	(mapc #'delete-window
	167	(get-buffer-window-list process-buffer nil t))
	168	(kill-buffer process-buffer)
	169
	170	;; Put the output or the value in the result section of
	171	;; the code block.
	172	(setq result
	173	(concat
	174	(nrepl-dict-get response
	175	(if (or (member "output" result-params)
	176	(member "pp" result-params))
	177	"out"
	178	"value"))
	179	(nrepl-dict-get response "ex")
	180	(nrepl-dict-get response "root-ex")
	181	(nrepl-dict-get response "err")))))))
	182	(slime
	183	(require 'slime)
	184	(with-temp-buffer
	185	(insert expanded)
	186	(setq result
	187	(slime-eval
	188	`(swank:eval-and-grab-output
	189	,(buffer-substring-no-properties (point-min) (point-max)))
	190	(cdr (assq :package params)))))))
	191	(org-babel-result-cond (cdr (assq :result-params params))
	192	result
	193	(condition-case nil (org-babel-script-escape result)
	194	(error result)))))
	195
	196	(provide 'ob-clojure)
	197
	198	;;; ob-clojure.el ends here