ob-J.el (6231B)
1 ;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2011-2021 Free Software Foundation, Inc. 4 5 ;; Author: Oleh Krehel 6 ;; Maintainer: Joseph Novakovich <josephnovakovich@gmail.com> 7 ;; Keywords: literate programming, reproducible research 8 ;; Homepage: https://git.sr.ht/~bzg/org-contrib 9 10 ;; This file is not 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 ;; Org-Babel support for evaluating J code. 28 ;; 29 ;; Session interaction depends on `j-console' from package `j-mode' 30 ;; (available in MELPA). 31 32 ;;; Code: 33 34 (require 'ob) 35 (require 'org-macs) 36 37 (declare-function j-console-ensure-session "ext:j-console" ()) 38 39 (defcustom org-babel-J-command "jconsole" 40 "Command to call J." 41 :group 'org-babel 42 :version "26.1" 43 :package-version '(Org . "9.0") 44 :type 'string) 45 46 (defun org-babel-expand-body:J (body _params &optional _processed-params) 47 "Expand BODY according to PARAMS, return the expanded body. 48 PROCESSED-PARAMS isn't used yet." 49 (org-babel-J-interleave-echos-except-functions body)) 50 51 (defun org-babel-J-interleave-echos (body) 52 "Interleave echo',' between each source line of BODY." 53 (mapconcat #'identity (split-string body "\n") "\necho','\n")) 54 55 (defun org-babel-J-interleave-echos-except-functions (body) 56 "Interleave echo',' between source lines of BODY that aren't functions." 57 (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body) 58 (let ((s1 (substring body 0 (match-beginning 0))) 59 (s2 (match-string 0 body)) 60 (s3 (substring body (match-end 0)))) 61 (concat 62 (if (string= s1 "") 63 "" 64 (concat (org-babel-J-interleave-echos s1) 65 "\necho','\n")) 66 s2 67 "\necho','\n" 68 (org-babel-J-interleave-echos-except-functions s3))) 69 (org-babel-J-interleave-echos body))) 70 71 (defalias 'org-babel-execute:j 'org-babel-execute:J) 72 73 (defun org-babel-execute:J (body params) 74 "Execute a block of J code BODY. 75 PARAMS are given by org-babel. 76 This function is called by `org-babel-execute-src-block'." 77 (message "executing J source code block") 78 (let* ((processed-params (org-babel-process-params params)) 79 (sessionp (cdr (assq :session params))) 80 (sit-time (let ((sit (assq :sit params))) 81 (if sit (cdr sit) .1))) 82 (full-body (org-babel-expand-body:J 83 body params processed-params)) 84 (tmp-script-file (org-babel-temp-file "J-src"))) 85 (org-babel-j-initiate-session sessionp) 86 (org-babel-J-strip-whitespace 87 (if (string= sessionp "none") 88 (progn 89 (with-temp-file tmp-script-file 90 (insert full-body)) 91 (org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file) "")) 92 (org-babel-J-eval-string full-body sit-time))))) 93 94 (defun org-babel-J-eval-string (str sit-time) 95 "Sends STR to the `j-console-cmd' session and execute it." 96 (let ((session (j-console-ensure-session))) 97 (with-current-buffer (process-buffer session) 98 (goto-char (point-max)) 99 (insert (format "\n%s\n" str)) 100 (let ((beg (point))) 101 (comint-send-input) 102 (sit-for sit-time) 103 (buffer-substring-no-properties 104 beg (point-max)))))) 105 106 (defun org-babel-J-strip-whitespace (str) 107 "Remove whitespace from jconsole output STR." 108 (mapconcat 109 #'identity 110 (delete "" (mapcar 111 #'org-babel-J-print-block 112 (split-string str "^ *,\n" t))) 113 "\n\n")) 114 115 (defun obj-get-string-alignment (str) 116 "Return a number to describe STR alignment. 117 STR represents a table. 118 Positive/negative/zero result means right/left/undetermined. 119 Don't trust first line." 120 (let* ((str (org-trim str)) 121 (lines (split-string str "\n" t)) 122 n1 n2) 123 (cond ((<= (length lines) 1) 124 0) 125 ((= (length lines) 2) 126 ;; numbers are right-aligned 127 (if (and 128 (numberp (read (car lines))) 129 (numberp (read (cadr lines))) 130 (setq n1 (obj-match-second-space-right (nth 0 lines))) 131 (setq n2 (obj-match-second-space-right (nth 1 lines)))) 132 n2 133 0)) 134 ((not (obj-match-second-space-left (nth 0 lines))) 135 0) 136 ((and 137 (setq n1 (obj-match-second-space-left (nth 1 lines))) 138 (setq n2 (obj-match-second-space-left (nth 2 lines))) 139 (= n1 n2)) 140 n1) 141 ((and 142 (setq n1 (obj-match-second-space-right (nth 1 lines))) 143 (setq n2 (obj-match-second-space-right (nth 2 lines))) 144 (= n1 n2)) 145 (- n1)) 146 (t 0)))) 147 148 (defun org-babel-J-print-block (x) 149 "Prettify jconsole output X." 150 (let* ((x (org-trim x)) 151 (a (obj-get-string-alignment x)) 152 (lines (split-string x "\n" t)) 153 b) 154 (cond ((< a 0) 155 (setq b (obj-match-second-space-right (nth 0 lines))) 156 (concat (make-string (+ a b) ? ) x)) 157 ((> a 0) 158 (setq b (obj-match-second-space-left (nth 0 lines))) 159 (concat (make-string (- a b) ? ) x)) 160 (t x)))) 161 162 (defun obj-match-second-space-left (s) 163 "Return position of leftmost space in second space block of S or nil." 164 (and (string-match "^ *[^ ]+\\( \\)" s) 165 (match-beginning 1))) 166 167 (defun obj-match-second-space-right (s) 168 "Return position of rightmost space in second space block of S or nil." 169 (and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s) 170 (match-beginning 1))) 171 172 (defun obj-string-match-m (regexp string &optional start) 173 "Call (string-match REGEXP STRING START). 174 REGEXP is modified so that .* matches newlines as well." 175 (string-match 176 (replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp) 177 string 178 start)) 179 180 (defun org-babel-j-initiate-session (&optional session) 181 "Initiate a J session. 182 SESSION is a parameter given by org-babel." 183 (unless (string= session "none") 184 (require 'j-console) 185 (j-console-ensure-session))) 186 187 (provide 'ob-J) 188 189 ;;; ob-J.el ends here