config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

ob-clojure.el (13942B)


      1 ;;; ob-clojure.el --- Babel Functions for Clojure    -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc.
      4 
      5 ;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
      6 ;; Maintainer: Daniel Kraus <daniel@kraus.my>
      7 ;;
      8 ;; Keywords: literate programming, reproducible research
      9 ;; URL: https://orgmode.org
     10 
     11 ;; This file is part of GNU Emacs.
     12 
     13 ;; GNU Emacs is free software: you can redistribute it and/or modify
     14 ;; it under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation, either version 3 of the License, or
     16 ;; (at your option) any later version.
     17 
     18 ;; GNU Emacs is distributed in the hope that it will be useful,
     19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     21 ;; GNU General Public License for more details.
     22 
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     25 
     26 ;;; Commentary:
     27 
     28 ;; Support for evaluating Clojure / ClojureScript code.
     29 
     30 ;; Requirements:
     31 
     32 ;; - Clojure (at least 1.2.0)
     33 ;; - clojure-mode
     34 ;; - babashka, nbb, Clojure CLI tools, Cider, inf-clojure or SLIME
     35 
     36 ;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
     37 ;; For babashka, see https://github.com/babashka/babashka
     38 ;; For nbb, see https://github.com/babashka/nbb
     39 ;; For Clojure CLI tools, see https://clojure.org/guides/deps_and_cli
     40 ;; For Cider, see https://github.com/clojure-emacs/cider
     41 ;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure
     42 ;; For SLIME, see https://slime.common-lisp.dev
     43 
     44 ;; For SLIME, the best way to install its components is by following
     45 ;; the directions as set out by Phil Hagelberg (Technomancy) on the
     46 ;; web page: https://technomancy.us/126
     47 
     48 ;;; Code:
     49 
     50 (require 'org-macs)
     51 (org-assert-version)
     52 
     53 (require 'ob)
     54 
     55 (declare-function cider-current-connection "ext:cider-client" (&optional type))
     56 (declare-function cider-current-ns "ext:cider-client" ())
     57 (declare-function inf-clojure "ext:inf-clojure" (cmd))
     58 (declare-function inf-clojure-cmd "ext:inf-clojure" (project-type))
     59 (declare-function inf-clojure-eval-string "ext:inf-clojure" (code))
     60 (declare-function inf-clojure-project-type "ext:inf-clojure" ())
     61 (declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
     62 (declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling))
     63 (declare-function sesman-start-session "ext:sesman" (system))
     64 (declare-function slime-eval "ext:slime" (sexp &optional package))
     65 
     66 (defvar cider-buffer-ns)
     67 
     68 (defvar org-babel-tangle-lang-exts)
     69 (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
     70 (add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs"))
     71 
     72 (defvar org-babel-default-header-args:clojure '())
     73 (defvar org-babel-header-args:clojure
     74   '((ns . :any)
     75     (package . :any)
     76     (backend . ((inf-clojure cider slime babashka nbb)))))
     77 (defvar org-babel-default-header-args:clojurescript '())
     78 (defvar org-babel-header-args:clojurescript '((package . :any)))
     79 
     80 (defcustom org-babel-clojure-backend (cond
     81                                       ((executable-find "bb") 'babashka)
     82                                       ((executable-find "clojure") 'clojure-cli)
     83                                       ((featurep 'cider) 'cider)
     84                                       ((featurep 'inf-clojure) 'inf-clojure)
     85                                       ((featurep 'slime) 'slime)
     86 				      (t nil))
     87   "Backend used to evaluate Clojure code blocks."
     88   :group 'org-babel
     89   :package-version '(Org . "9.7")
     90   :type '(choice
     91 	  (const :tag "babashka" babashka)
     92           (const :tag "clojure-cli" clojure-cli)
     93 	  (const :tag "cider" cider)
     94 	  (const :tag "inf-clojure" inf-clojure)
     95 	  (const :tag "slime" slime)
     96 	  (const :tag "Not configured yet" nil)))
     97 
     98 (defcustom org-babel-clojurescript-backend
     99   (cond
    100    ((or (executable-find "nbb") (executable-find "npx")) 'nbb)
    101    ((featurep 'cider) 'cider)
    102    (t nil))
    103   "Backend used to evaluate ClojureScript code blocks."
    104   :group 'org-babel
    105   :package-version '(Org . "9.7")
    106   :type '(choice
    107 	  (const :tag "nbb" nbb)
    108 	  (const :tag "cider" cider)
    109 	  (const :tag "Not configured yet" nil)))
    110 
    111 (defcustom org-babel-clojure-default-ns "user"
    112   "Default Clojure namespace for source block when finding ns failed."
    113   :type 'string
    114   :group 'org-babel)
    115 
    116 (defcustom ob-clojure-babashka-command (executable-find "bb")
    117   "Babashka command used by the Clojure `babashka' backend."
    118   :type '(choice file (const nil))
    119   :group 'org-babel
    120   :package-version '(Org . "9.6"))
    121 
    122 (defcustom ob-clojure-nbb-command (or (executable-find "nbb")
    123                                       (when-let* ((npx (executable-find "npx")))
    124                                         (concat npx " nbb")))
    125   "Nbb command used by the ClojureScript `nbb' backend."
    126   :type '(choice string (const nil))
    127   :group 'org-babel
    128   :package-version '(Org . "9.7"))
    129 
    130 (defcustom ob-clojure-cli-command (when-let* ((cmd (executable-find "clojure")))
    131                                     (concat cmd " -M"))
    132   "Clojure CLI command used by the Clojure `clojure-cli' backend."
    133   :type '(choice string (const nil))
    134   :group 'org-babel
    135   :package-version '(Org . "9.7"))
    136 
    137 (defun org-babel-expand-body:clojure (body params &optional cljs-p)
    138   "Expand BODY according to PARAMS, return the expanded body.
    139 When CLJS-P is non-nil, expand in a cljs context instead of clj."
    140   (let* ((vars (org-babel--get-vars params))
    141          (backend-override (cdr (assq :backend params)))
    142          (org-babel-clojure-backend
    143           (cond
    144            (backend-override (intern backend-override))
    145            (org-babel-clojure-backend org-babel-clojure-backend)
    146            (t (user-error "You need to customize `org-babel-clojure-backend'
    147 or set the `:backend' header argument"))))
    148 	 (ns (or (cdr (assq :ns params))
    149 		 (if (eq org-babel-clojure-backend 'cider)
    150 		     (or cider-buffer-ns
    151 			 (let ((repl-buf (cider-current-connection)))
    152 			   (and repl-buf (buffer-local-value
    153 					  'cider-buffer-ns repl-buf))))
    154 		   org-babel-clojure-default-ns)))
    155 	 (result-params (cdr (assq :result-params params)))
    156 	 (print-level nil)
    157 	 (print-length nil)
    158 	 ;; Remove comments, they break (let [...] ...) bindings
    159 	 (body (replace-regexp-in-string "^[ 	]*;+.*$" "" body))
    160 	 (body (org-trim
    161 		(concat
    162 		 ;; Source block specified namespace :ns.
    163 		 (and (cdr (assq :ns params)) (format "(ns %s)\n" ns))
    164 		 ;; Variables binding.
    165 		 (if (null vars) (org-trim body)
    166 		   (format "(let [%s]\n%s)"
    167 			   (mapconcat
    168 			    (lambda (var)
    169 			      (format "%S '%S" (car var) (cdr var)))
    170 			    vars
    171 			    "\n      ")
    172 			   body))))))
    173     ;; If the result param is set to "output" we don't have to do
    174     ;; anything special and just let the backend handle everything
    175     (if (member "output" result-params)
    176         body
    177 
    178       ;; If the result is not "output" (i.e. it's "value"), disable
    179       ;; stdout output and print the last returned value.  Use pprint
    180       ;; instead of prn when results param is "pp" or "code".
    181       (concat
    182        (if (or (member "code" result-params)
    183 	       (member "pp" result-params))
    184            (concat (if cljs-p
    185                        "(require '[cljs.pprint :refer [pprint]])"
    186                      "(require '[clojure.pprint :refer [pprint]])")
    187                    " (pprint ")
    188          "(prn ")
    189        (if cljs-p
    190            "(binding [cljs.core/*print-fn* (constantly nil)]"
    191          "(binding [*out* (java.io.StringWriter.)]")
    192        body "))"))))
    193 
    194 (defvar ob-clojure-inf-clojure-filter-out)
    195 (defvar ob-clojure-inf-clojure-tmp-output)
    196 (defun ob-clojure-inf-clojure-output (s)
    197   "Store a trimmed version of S in a variable and return S."
    198   (let ((s0 (org-trim
    199 	     (replace-regexp-in-string
    200 	      ob-clojure-inf-clojure-filter-out "" s))))
    201     (push s0 ob-clojure-inf-clojure-tmp-output))
    202   s)
    203 
    204 (defmacro ob-clojure-with-temp-expanded (expanded params &rest body)
    205   "Run BODY on EXPANDED code block with PARAMS."
    206   (declare (debug (body)) (indent 2))
    207   `(with-temp-buffer
    208      (insert ,expanded)
    209      (goto-char (point-min))
    210      (while (not (looking-at "\\s-*\\'"))
    211        (let* ((beg (point))
    212 	      (end (progn (forward-sexp) (point)))
    213 	      (exp (org-babel-expand-body:clojure
    214 		    (buffer-substring beg end) ,params)))
    215 	 (sit-for .1)
    216 	 ,@body))))
    217 
    218 (defsubst ob-clojure-string-or-list (l)
    219   "Convert list L into a string or a list of list."
    220   (if (and (listp l) (= (length l) 1))
    221       (car l)
    222     (mapcar #'list l)))
    223 
    224 (defvar inf-clojure-buffer)
    225 (defvar comint-prompt-regexp)
    226 (defvar inf-clojure-comint-prompt-regexp)
    227 (defun ob-clojure-eval-with-inf-clojure (expanded params)
    228   "Evaluate EXPANDED code block with PARAMS using inf-clojure."
    229   (org-require-package 'inf-clojure)
    230   ;; Maybe initiate the inf-clojure session
    231   (unless (and inf-clojure-buffer
    232 	       (buffer-live-p (get-buffer inf-clojure-buffer)))
    233     (save-window-excursion
    234       (let* ((alias (cdr (assq :alias params)))
    235 	     (cmd0 (inf-clojure-cmd (inf-clojure-project-type)))
    236 	     (cmd (if alias (replace-regexp-in-string
    237 			     "clojure" (format "clojure -A%s" alias)
    238 			     cmd0)
    239 		    cmd0)))
    240 	(setq
    241          org-babel-comint-prompt-regexp-old comint-prompt-regexp
    242          comint-prompt-regexp inf-clojure-comint-prompt-regexp)
    243 	(funcall-interactively #'inf-clojure cmd)
    244 	(goto-char (point-max))))
    245     (sit-for 1))
    246   ;; Now evaluate the code
    247   (setq ob-clojure-inf-clojure-filter-out
    248 	(concat "^nil\\|nil$\\|\\s-*"
    249 		(or (cdr (assq :ns params))
    250 		    org-babel-clojure-default-ns)
    251 		"=>\\s-*"))
    252   (add-hook 'comint-preoutput-filter-functions
    253 	    #'ob-clojure-inf-clojure-output)
    254   (setq ob-clojure-inf-clojure-tmp-output nil)
    255   (ob-clojure-with-temp-expanded expanded nil
    256     (inf-clojure-eval-string exp))
    257   (sit-for .5)
    258   (remove-hook 'comint-preoutput-filter-functions
    259 	       #'ob-clojure-inf-clojure-output)
    260   ;; And return the result
    261   (ob-clojure-string-or-list
    262    (delete nil
    263 	   (mapcar
    264 	    (lambda (s)
    265 	      (unless (or (equal "" s)
    266 			  (string-match-p "^Clojure" s))
    267 		s))
    268 	    (reverse ob-clojure-inf-clojure-tmp-output)))))
    269 
    270 (defun ob-clojure-eval-with-cider (expanded _params &optional cljs-p)
    271   "Evaluate EXPANDED code block using cider.
    272 When CLJS-P is non-nil, use a cljs connection instead of clj.
    273 The PARAMS from Babel are not used in this function."
    274   (org-require-package 'cider "Cider")
    275   (let ((connection (cider-current-connection (if cljs-p "cljs" "clj"))))
    276     (unless connection (sesman-start-session 'CIDER))
    277     (if (not connection)
    278 	;; Display in the result instead of using `user-error'
    279         "Please reevaluate when nREPL is connected"
    280       (let ((response (nrepl-sync-request:eval expanded connection)))
    281         (or (nrepl-dict-get response "root-ex")
    282 	    (nrepl-dict-get response "ex")
    283 	    (nrepl-dict-get response "out"))))))
    284 
    285 (defun ob-clojure-eval-with-slime (expanded params)
    286   "Evaluate EXPANDED code block with PARAMS using slime."
    287   (org-require-package 'slime "SLIME")
    288   (with-temp-buffer
    289     (insert expanded)
    290     (slime-eval
    291      `(swank:eval-and-grab-output
    292        ,(buffer-substring-no-properties (point-min) (point-max)))
    293      (cdr (assq :package params)))))
    294 
    295 (defun ob-clojure-eval-with-cmd (cmd expanded)
    296   "Evaluate EXPANDED code block using CMD (babashka, clojure or nbb)."
    297   (let ((script-file (org-babel-temp-file "clojure-cmd-script-" ".clj")))
    298     (with-temp-file script-file
    299       (insert expanded))
    300     (org-babel-eval
    301      (format "%s %s" cmd (org-babel-process-file-name script-file))
    302      "")))
    303 
    304 (defun org-babel-execute:clojure (body params &optional cljs-p)
    305   "Execute the BODY block of Clojure code with PARAMS using Babel.
    306 When CLJS-P is non-nil, execute with a ClojureScript backend
    307 instead of Clojure."
    308   (let* ((backend-override (cdr (assq :backend params)))
    309          (org-babel-clojure-backend
    310           (cond
    311            (backend-override (intern backend-override))
    312            (org-babel-clojure-backend (if cljs-p
    313                                           org-babel-clojurescript-backend
    314                                         org-babel-clojure-backend))
    315            (t (user-error "You need to customize `%S'
    316 or set the `:backend' header argument"
    317                           (if cljs-p
    318                               org-babel-clojurescript-backend
    319                             org-babel-clojure-backend)))))
    320          ;; We allow a Clojure source block to be evaluated with the
    321          ;; nbb backend and therefore have to expand the body with
    322          ;; ClojureScript syntax when we either evaluate a
    323          ;; ClojureScript source block or use the nbb backend.
    324          (cljs-p (or cljs-p (eq org-babel-clojure-backend 'nbb))))
    325     (let* ((expanded (org-babel-expand-body:clojure body params cljs-p))
    326 	   (result-params (cdr (assq :result-params params)))
    327 	   result)
    328       (setq result
    329 	    (cond
    330 	     ((eq org-babel-clojure-backend 'inf-clojure)
    331 	      (ob-clojure-eval-with-inf-clojure expanded params))
    332              ((eq org-babel-clojure-backend 'clojure-cli)
    333               (ob-clojure-eval-with-cmd ob-clojure-cli-command expanded))
    334              ((eq org-babel-clojure-backend 'babashka)
    335 	      (ob-clojure-eval-with-cmd ob-clojure-babashka-command expanded))
    336              ((eq org-babel-clojure-backend 'nbb)
    337 	      (ob-clojure-eval-with-cmd ob-clojure-nbb-command expanded))
    338 	     ((eq org-babel-clojure-backend 'cider)
    339 	      (ob-clojure-eval-with-cider expanded params cljs-p))
    340 	     ((eq org-babel-clojure-backend 'slime)
    341 	      (ob-clojure-eval-with-slime expanded params))
    342              (t (user-error "Invalid backend"))))
    343       (org-babel-result-cond result-params
    344         result
    345         (condition-case nil (org-babel-script-escape result)
    346 	  (error result))))))
    347 
    348 (defun org-babel-execute:clojurescript (body params)
    349   "Evaluate BODY with PARAMS as ClojureScript code."
    350   (org-babel-execute:clojure body params t))
    351 
    352 (provide 'ob-clojure)
    353 
    354 ;;; ob-clojure.el ends here