Browse Source

ob-clojure: Support `org-babel-initiate-session'

* ob-clojure.el (org-babel-clojure-initiate-session): Initialize session
for source block.
(org-babel-prep-session:clojure): Prepare Clojure session.
(org-babel-clojure-var-to-clojure): Convert header argument :var into
clojure variables definitions.
(org-babel-variable-assignments:clojure): Support assigning variables
when initializing a session.
stardiviner 1 year ago
parent
commit
4456dc8809
3 changed files with 132 additions and 56 deletions
  1. 0 56
      contrib/lisp/ob-clojure-literate.el
  2. 55 0
      lisp/ob-clojure.el
  3. 77 0
      testing/lisp/test-ob-clojure.el

+ 0 - 56
contrib/lisp/ob-clojure-literate.el

@@ -184,62 +184,6 @@ If it is a directory, `ob-clojure-literate' will try to create Clojure project a
                  (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."
-  (if (listp var)
-      (replace-regexp-in-string "(" "'(" var)
-    (cond
-     ((stringp var)
-      ;; wrap org-babel passed in header argument value with quote in Clojure.
-      (format "\"%s\"" var))
-     (t
-      (format "%s" var))))
-  )
-
-(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))))
-   (org-babel--get-vars params)))
 
 ;;; Support header arguments  :results graphics :file "image.png" by inject Clojure code.
 (defun ob-clojure-literate-inject-code (args)

+ 55 - 0
lisp/ob-clojure.el

@@ -43,6 +43,7 @@
 (require 'ob)
 (require 'org-macs)
 
+(declare-function cider-jack-in "ext:cider" (&optional prompt-project cljs-too))
 (declare-function cider-current-connection "ext:cider-client" (&optional type))
 (declare-function cider-current-ns "ext:cider-client" ())
 (declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2))
@@ -211,6 +212,60 @@ using the :show-process parameter."
       (condition-case nil (org-babel-script-escape result)
 	(error result)))))
 
+(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
+      (cond
+       ((org-babel-comint-buffer-livep session) nil)
+       ;; CIDER jack-in to the Clojure project directory.
+       ((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
+	(dolist (var var-lines)
+	  (insert var)
+	  (comint-send-input nil t)
+	  (org-babel-comint-wait-for-output session)
+	  (sit-for .1)
+	  (goto-char (point-max)))))
+    session))
+
+(defun org-babel-clojure-var-to-clojure (var)
+  "Convert src block's VAR to Clojure variable."
+  (cond
+   ((listp var)
+    (replace-regexp-in-string "(" "'(" var))
+   ((stringp var)
+    ;; Wrap Babel passed-in header argument value with quotes in Clojure.
+    (format "\"%s\"" var))
+   (t
+    (format "%S" var))))
+
+(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))))
+   (org-babel--get-vars params)))
+
 (provide 'ob-clojure)
 
 ;;; ob-clojure.el ends here

+ 77 - 0
testing/lisp/test-ob-clojure.el

@@ -0,0 +1,77 @@
+;;; test-ob-clojure.el
+
+;; Copyright (c) 2018-2022 Free Software Foundation, Inc.
+;; Authors: stardiviner
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Comments:
+
+;; Org tests for ob-clojure.el live here
+
+;;; Code:
+(org-test-for-executable "cider")
+(unless (featurep 'cider)
+  (signal 'missing-test-dependency "CIDER"))
+(unless (featurep 'ob-clojure)
+  (signal 'missing-test-dependency "Support for Clojure code blocks"))
+
+(ert-deftest ob-clojure/simple-session ()
+  (org-test-with-temp-text
+      "#+begin_src clojure :session
+(print \"hello, world\")
+#+end_src
+"
+    (should (string= "hello, world" (org-babel-execute-src-block)))))
+
+(ert-deftest ob-clojure/initiate-session ()
+  (org-test-with-temp-text
+      "#+begin_src clojure :session :var a=1 :results output
+(print \"hello, world\")
+#+end_src
+
+#+begin_src clojure :session :results output
+(print a)
+#+end_src"
+    (goto-char (point-min))
+    (org-babel-switch-to-session)
+    (sleep-for 2)
+    (org-babel-execute-maybe)
+    (org-babel-next-src-block)
+    (goto-char (org-babel-result-end))
+    (forward-line 2)
+    (should (string=
+	     ": 1"
+	     (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
+
+(ert-deftest ob-clojure/initiate-session-with-var ()
+  (org-test-with-temp-text
+      "#+begin_src clojure :session :var a=1 :results output
+(print a)
+#+end_src"
+    (org-babel-next-src-block)
+    (org-babel-initiate-session)
+    (sleep-for 2)
+    (org-babel-execute-maybe)
+    (goto-char (org-babel-result-end))
+    (forward-line 2)
+    (should (string=
+	     ": 1"
+	     (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
+
+(provide 'test-ob-clojure)
+
+ ;;; test-ob-clojure.el ends here