lisp/ob-J.el

   1 ;;; ob-J.el --- org-babel functions for J evaluation
   2
   3 ;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel
   6 ;; Keywords: literate programming, reproducible research
   7 ;; Homepage: http://orgmode.org
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15
  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.
  20
  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/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Session interaction depends on `j-console'.
  27
  28 ;;; Code:
  29 (require 'ob)
  30
  31 (defun org-babel-expand-body:J (body params &optional processed-params)
  32   "Expand BODY according to PARAMS, return the expanded body.
  33 PROCESSED-PARAMS isn't used yet."
  34   (org-babel-J-interleave-echos-except-functions body))
  35
  36 (defun org-babel-J-interleave-echos (body)
  37   "Interleave echo'' between each source line of BODY."
  38   (mapconcat #'identity (split-string body "\n") "\necho''\n"))
  39
  40 (defun org-babel-J-interleave-echos-except-functions (body)
  41   "Interleave echo'' between source lines of BODY that aren't functions."
  42   (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:1\\|2\\|3\\|4\\) : 0\n.*)" body)
  43       (let ((s1 (substring body 0 (match-beginning 0)))
  44             (s2 (match-string 0 body))
  45             (s3 (substring body (match-end 0))))
  46         (concat
  47          (org-babel-J-interleave-echos s1)
  48          "\necho''\n"
  49          s2
  50          (org-babel-J-interleave-echos-except-functions s3)))
  51     (org-babel-J-interleave-echos body)))
  52
  53 (defun org-babel-execute:J (body params)
  54   "Execute a block of J code BODY.
  55 PARAMS are given by org-babel.
  56 This function is called by `org-babel-execute-src-block'"
  57   (message "executing J source code block")
  58   (let* ((processed-params (org-babel-process-params params))
  59          (sessionp (cdr (assoc :session params)))
  60          (session (org-babel-j-initiate-session sessionp))
  61          (vars (second processed-params))
  62          (result-params (third processed-params))
  63          (result-type (fourth processed-params))
  64          (full-body (org-babel-expand-body:J
  65                      body params processed-params))
  66          (tmp-script-file (org-babel-temp-file "J-src")))
  67     (org-babel-J-strip-whitespace
  68      (if (string= sessionp "none")
  69          (progn
  70            (with-temp-file tmp-script-file
  71              (insert full-body))
  72            (org-babel-eval (format "jconsole < %s" tmp-script-file) ""))
  73        (org-babel-J-eval-string full-body)))))
  74
  75 (defun org-babel-J-eval-string (str)
  76   "Sends STR to the `j-console-cmd' session and exectues it."
  77   (let ((session (j-console-ensure-session)))
  78     (with-current-buffer (process-buffer session)
  79       (goto-char (point-max))
  80       (insert (format "\n%s\n" str))
  81       (let ((beg (point)))
  82         (comint-send-input)
  83         (sit-for .1)
  84         (buffer-substring-no-properties
  85          beg (point-max))))))
  86
  87 (defun org-babel-J-strip-whitespace (str)
  88   "Remove whitespace from jconsole output STR."
  89   (let ((strs (split-string str "\n" t))
  90         out cur s)
  91     (while (setq s (pop strs))
  92       (if (string-match "^ *$" s)
  93           (progn (push (nreverse cur) out)
  94                  (setq cur))
  95         (push s cur)))
  96     (mapconcat #'org-babel-J-print-block
  97                (delq nil (nreverse out))
  98                "\n\n")))
  99
 100 (defun org-babel-J-print-block (x)
 101   "Prettify jconsole output X."
 102   (if (= 1 (length x))
 103       (obj-strip-leading-ws (car x))
 104     ;; assume only first row is misaligned
 105     (let ((n1 (obj-match-second-space (car x)))
 106           (n2 (obj-match-second-space (cadr x))))
 107       (setcar
 108        x
 109        (if (and n1 n2)
 110            (substring (car x) (- n1 n2))
 111          (obj-strip-leading-ws (car x))))
 112       (mapconcat #'identity x "\n"))))
 113
 114 (defun obj-match-second-space (s)
 115   "Return position of second space in S or nil."
 116   (and (string-match "^ *[^ ]+\\( \\)" s)
 117        (match-beginning 1)))
 118
 119 (defun obj-strip-leading-ws (s)
 120   "String leading whitespace from S."
 121   (and (string-match "^ *\\([^ ].*\\)" s)
 122        (match-string 1 s)))
 123
 124 (defun obj-string-match-m (regexp string &optional start)
 125   "Like `sting-match', only .* includes newlines too."
 126   (string-match
 127    (replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp)
 128    string
 129    start))
 130
 131 (defun org-babel-j-initiate-session (&optional session)
 132   "Initiate a J session.
 133 SESSION is a parameter given by org-babel."
 134   (unless (string= session "none")
 135     (require 'j-console)
 136     (j-console-ensure-session)))
 137
 138 (provide 'ob-J)
 139
 140 ;;; ob-J.el ends here