Browse Source

ob-J.el: Fix display of 3-dimensional arrays.

* lisp/ob-J.el (org-babel-J-interleave-echos): Change '' to ','.
  (org-babel-J-interleave-echos-except-functions): Improve regexp
  and change '' to ','.
  (org-babel-J-strip-whitespace): Change '' to ','.
  (obj-get-string-alignment): New function.
  (org-babel-J-print-block): Accomodate left- and right-aligned tables.
  (obj-match-second-space): Rename.
  (obj-match-second-space-left): Renamed from `obj-match-second-space'.
  (obj-match-second-space-right): New function.
Oleh Krehel 11 years ago
parent
commit
8c67695e62
1 changed files with 66 additions and 29 deletions
  1. 66 29
      lisp/ob-J.el

+ 66 - 29
lisp/ob-J.el

@@ -23,7 +23,8 @@
 
 ;;; Commentary:
 
-;; Session interaction depends on `j-console'.
+;; Org-Babel support for evaluating J code.
+;; Session interaction depends on `j-console' provided by `j-mode'.
 
 ;;; Code:
 (require 'ob)
@@ -35,18 +36,21 @@ PROCESSED-PARAMS isn't used yet."
 
 (defun org-babel-J-interleave-echos (body)
   "Interleave echo'' between each source line of BODY."
-  (mapconcat #'identity (split-string body "\n") "\necho''\n"))
+  (mapconcat #'identity (split-string body "\n") "\necho','\n"))
 
 (defun org-babel-J-interleave-echos-except-functions (body)
   "Interleave echo'' between source lines of BODY that aren't functions."
-  (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:1\\|2\\|3\\|4\\) : 0\n.*)\\(?:\n\\|$\\)" body)
+  (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body)
       (let ((s1 (substring body 0 (match-beginning 0)))
 	    (s2 (match-string 0 body))
 	    (s3 (substring body (match-end 0))))
 	(concat
-	 (org-babel-J-interleave-echos s1)
-	 "\necho''\n"
+	 (if (string= s1 "")
+	     ""
+	   (concat (org-babel-J-interleave-echos s1)
+		   "\necho','\n"))
 	 s2
+	 "\necho','\n"
 	 (org-babel-J-interleave-echos-except-functions s3)))
     (org-babel-J-interleave-echos body)))
 
@@ -86,36 +90,69 @@ This function is called by `org-babel-execute-src-block'"
 
 (defun org-babel-J-strip-whitespace (str)
   "Remove whitespace from jconsole output STR."
-  (let ((strs (split-string str "\n" t))
-	out cur s)
-    (while (setq s (pop strs))
-      (if (string-match "^ *$" s)
-	  (progn (push (nreverse cur) out)
-		 (setq cur))
-	(push s cur)))
-    (mapconcat #'org-babel-J-print-block
-	       (delq nil (nreverse out))
-	       "\n\n")))
+  (mapconcat
+   #'identity
+   (delete "" (mapcar
+	       #'org-babel-J-print-block
+	       (split-string str "^ *,\n" t)))
+   "\n\n"))
+
+(defun obj-get-string-alignment (str)
+  "Return a number to describe STR alignment.
+Positive/negative/zero mean right/left/undetermined.
+Don't trust first line."
+  (let* ((str (org-trim str))
+	 (lines (split-string str "\n" t))
+	 n1 n2)
+    (cond ((<= (length lines) 1)
+	   0)
+	  ((= (length lines) 2)
+	   ;; numbers are right-aligned
+	   (if (and
+		(numberp (read (car lines)))
+		(numberp (read (cadr lines)))
+		(setq n1 (obj-match-second-space-right (nth 0 lines)))
+		(setq n2 (obj-match-second-space-right (nth 1 lines))))
+	       n2
+	     0))
+	  ((not (obj-match-second-space (nth 0 lines)))
+	   0)
+	  ((and
+	    (setq n1 (obj-match-second-space-left (nth 1 lines)))
+	    (setq n2 (obj-match-second-space-left (nth 2 lines)))
+	    (= n1 n2))
+	   n1)
+	  ((and
+	    (setq n1 (obj-match-second-space-right (nth 1 lines)))
+	    (setq n2 (obj-match-second-space-right (nth 2 lines)))
+	    (= n1 n2))
+	   (- n1))
+	  (t 0))))
 
 (defun org-babel-J-print-block (x)
   "Prettify jconsole output X."
-  (if (= 1 (length x))
-      (org-trim (car x))
-    ;; assume only first row is misaligned
-    (let ((n1 (obj-match-second-space (car x)))
-	  (n2 (obj-match-second-space (cadr x))))
-      (setcar
-       x
-       (if (and n1 n2)
-	   (substring (car x) (- n1 n2))
-	 (org-trim (car x))))
-      (mapconcat #'identity x "\n"))))
-
-(defun obj-match-second-space (s)
-  "Return position of second space in S or nil."
+  (let* ((x (org-trim x))
+	 (a (obj-get-string-alignment x))
+	 (lines (split-string x "\n" t))
+	 b)
+    (cond ((minusp a)
+	   (setq b (obj-match-second-space-right (nth 0 lines)))
+	   (concat (make-string (+ a b) ? ) x))
+	  ((plusp a)
+	   (setq b (obj-match-second-space-left (nth 0 lines)))
+	   (concat (make-string (- a b) ? ) x))
+	  (t x))))
+
+(defun obj-match-second-space-left (s)
+  "Return position of leftmost space in second space block of S or nil."
   (and (string-match "^ *[^ ]+\\( \\)" s)
        (match-beginning 1)))
 
+(defun obj-match-second-space-right (s)
+  "Return position of rightmost space in second space block of S or nil."
+  (and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s)
+       (match-beginning 1)))
+
 (defun obj-string-match-m (regexp string &optional start)
   "Like `sting-match', only .* includes newlines too."
   (string-match