1 ;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
6 ;; Keywords: literate programming, reproducible research
7 ;; Homepage: http://orgmode.org
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Org-Babel support for evaluating J code.
28 ;; Session interaction depends on `j-console' from package `j-mode'
29 ;; (available in MELPA).
35 (defcustom org-babel-J-command
41 (declare-function org-trim
"org" (s &optional keep-lead
))
42 (declare-function j-console-ensure-session
"ext:j-console" ())
44 (defun org-babel-expand-body:J
(body _params
&optional _processed-params
)
45 "Expand BODY according to PARAMS, return the expanded body.
46 PROCESSED-PARAMS isn't used yet."
47 (org-babel-J-interleave-echos-except-functions body
))
49 (defun org-babel-J-interleave-echos (body)
50 "Interleave echo',' between each source line of BODY."
51 (mapconcat #'identity
(split-string body
"\n") "\necho','\n"))
53 (defun org-babel-J-interleave-echos-except-functions (body)
54 "Interleave echo',' between source lines of BODY that aren't functions."
55 (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body
)
56 (let ((s1 (substring body
0 (match-beginning 0)))
57 (s2 (match-string 0 body
))
58 (s3 (substring body
(match-end 0))))
62 (concat (org-babel-J-interleave-echos s1
)
66 (org-babel-J-interleave-echos-except-functions s3
)))
67 (org-babel-J-interleave-echos body
)))
69 (defun org-babel-execute:J
(body params
)
70 "Execute a block of J code BODY.
71 PARAMS are given by org-babel.
72 This function is called by `org-babel-execute-src-block'"
73 (message "executing J source code block")
74 (let* ((processed-params (org-babel-process-params params
))
75 (sessionp (cdr (assoc :session params
)))
76 (full-body (org-babel-expand-body:J
77 body params processed-params
))
78 (tmp-script-file (org-babel-temp-file "J-src")))
79 (org-babel-j-initiate-session sessionp
)
80 (org-babel-J-strip-whitespace
81 (if (string= sessionp
"none")
83 (with-temp-file tmp-script-file
85 (org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file
) ""))
86 (org-babel-J-eval-string full-body
)))))
88 (defun org-babel-J-eval-string (str)
89 "Sends STR to the `j-console-cmd' session and exectues it."
90 (let ((session (j-console-ensure-session)))
91 (with-current-buffer (process-buffer session
)
92 (goto-char (point-max))
93 (insert (format "\n%s\n" str
))
97 (buffer-substring-no-properties
100 (defun org-babel-J-strip-whitespace (str)
101 "Remove whitespace from jconsole output STR."
105 #'org-babel-J-print-block
106 (split-string str
"^ *,\n" t
)))
109 (defun obj-get-string-alignment (str)
110 "Return a number to describe STR alignment.
111 STR represents a table.
112 Positive/negative/zero result means right/left/undetermined.
113 Don't trust first line."
114 (let* ((str (org-trim str
))
115 (lines (split-string str
"\n" t
))
117 (cond ((<= (length lines
) 1)
119 ((= (length lines
) 2)
120 ;; numbers are right-aligned
122 (numberp (read (car lines
)))
123 (numberp (read (cadr lines
)))
124 (setq n1
(obj-match-second-space-right (nth 0 lines
)))
125 (setq n2
(obj-match-second-space-right (nth 1 lines
))))
128 ((not (obj-match-second-space-left (nth 0 lines
)))
131 (setq n1
(obj-match-second-space-left (nth 1 lines
)))
132 (setq n2
(obj-match-second-space-left (nth 2 lines
)))
136 (setq n1
(obj-match-second-space-right (nth 1 lines
)))
137 (setq n2
(obj-match-second-space-right (nth 2 lines
)))
142 (defun org-babel-J-print-block (x)
143 "Prettify jconsole output X."
144 (let* ((x (org-trim x
))
145 (a (obj-get-string-alignment x
))
146 (lines (split-string x
"\n" t
))
149 (setq b
(obj-match-second-space-right (nth 0 lines
)))
150 (concat (make-string (+ a b
) ?
) x
))
152 (setq b
(obj-match-second-space-left (nth 0 lines
)))
153 (concat (make-string (- a b
) ?
) x
))
156 (defun obj-match-second-space-left (s)
157 "Return position of leftmost space in second space block of S or nil."
158 (and (string-match "^ *[^ ]+\\( \\)" s
)
159 (match-beginning 1)))
161 (defun obj-match-second-space-right (s)
162 "Return position of rightmost space in second space block of S or nil."
163 (and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s
)
164 (match-beginning 1)))
166 (defun obj-string-match-m (regexp string
&optional start
)
167 "Call (string-match REGEXP STRING START).
168 REGEXP is modified so that .* matches newlines as well."
170 (replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp
)
174 (defun org-babel-j-initiate-session (&optional session
)
175 "Initiate a J session.
176 SESSION is a parameter given by org-babel."
177 (unless (string= session
"none")
179 (j-console-ensure-session)))
183 ;;; ob-J.el ends here