Merge branch 'master' of git@github.com:eschulte/rorg

litorgy/init.el

@@ -1,8 +1,8 @@
 ;;; init.el --- loads litorgy
 
-;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
+;; Copyright (C) 2009 Eric Schulte
 
-;; Author: Eric Schulte, Dan Davison, Austin F. Frank
+;; Author: Eric Schulte
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
@@ -34,8 +34,8 @@
 (require 'litorgy-reference)
 
 ;; language specific files
-(require 'litorgy-R)
-(require 'litorgy-lisp)
 (require 'litorgy-script)
+(require 'litorgy-lisp)
+(require 'litorgy-R)
 
 ;;; init.el ends here

litorgy/litorgy-R.el

@@ -1,9 +1,9 @@
 ;;; litorgy-R.el --- litorgy functions for R code evaluation
 
-;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
+;; Copyright (C) 2009 Eric Schulte
 
-;; Author: Eric Schulte, Dan Davison, Austin F. Frank
-;; Keywords: literate programming, reproducible research
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, R, statistics
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
 
@@ -31,16 +31,87 @@
 ;;; Code:
 (require 'litorgy)
 
-(litorgy-add-interpreter "emacs-R")
+(litorgy-add-interpreter "R")
 
-(defun litorgy-execute:emacs-R (body params)
-  "Execute a block of emacs-R code with litorgy.  This
-function is called by `litorgy-execute-src-block'."
+(defun litorgy-execute:R (body params)
+  "Execute a block of R code with litorgy.  This function is
+called by `litorgy-execute-src-block'."
+  (message "executing R source code block...")
   (save-window-excursion
     (let ((vars (litorgy-reference-variables params))
           results)
-      ;;TODO: implement
-      (error "`litorgy-execute:emacs-R' is not implemented"))))
+      (litorgy-R-initiate-R-buffer)
+      (litorgy-R-command-to-string body))))
+
+;; functions for evaluation of R code
+(defvar litorgy-R-buffer nil
+  "Holds the buffer for the current R process")
+
+(defun litorgy-R-initiate-R-buffer ()
+  "If there is not a current R process then create one."
+  (unless (and (buffer-live-p litorgy-R-buffer) (get-buffer litorgy-R-buffer))
+    (save-excursion
+      (R)
+      (setf litorgy-R-buffer (current-buffer))
+      (litorgy-R-wait-for-output)
+      (litorgy-R-input-command ""))))
+
+(defun litorgy-R-command-to-string (command)
+  "Send a command to R, and return the results as a string."
+  (litorgy-R-input-command command)
+  (litorgy-R-last-output))
+
+(defun litorgy-R-input-command (command)
+  "Pass COMMAND to the R process running in `litorgy-R-buffer'."
+  (save-excursion
+    (save-match-data
+      (set-buffer litorgy-R-buffer)
+      (goto-char (process-mark (get-buffer-process (current-buffer))))
+      (insert command)
+      (comint-send-input)
+      (litorgy-R-wait-for-output))))
+
+(defun litorgy-R-wait-for-output ()
+  "Wait until output arrives"
+  (save-excursion
+    (save-match-data
+      (set-buffer litorgy-R-buffer)
+      (while (progn
+	       (goto-char comint-last-input-end)
+	       (not (re-search-forward comint-prompt-regexp nil t)))
+	(accept-process-output (get-buffer-process (current-buffer)))))))
+
+(defun litorgy-R-last-output ()
+  "Return the last R output as a string"
+  (save-excursion
+    (save-match-data
+      (set-buffer litorgy-R-buffer)
+      (goto-char (process-mark (get-buffer-process (current-buffer))))
+      (forward-line 0)
+      (let ((raw (buffer-substring comint-last-input-end (- (point) 1)))
+            output output-flag)
+        (mapconcat
+         (lambda (el)
+           (if (stringp el)
+               (format "%s" el)
+             (format "%S" el)))
+         (delq nil
+               (mapcar
+                (lambda (line)
+                  (unless (string-match "^>" line)
+                    (and (string-match "\\[[[:digit:]]+\\] *\\(.*\\)$" line)
+                         (match-string 1 line))))
+                ;; drop first, because it's the last line of input
+                (cdr (split-string raw "[\n\r]")))) "\n")))))
+
+(defun litorgy-R-table-or-results (results)
+  "If the results look like a matrix, then convert them into an
+Emacs-lisp table otherwise return the results as a string."
+  ;; TODO: these simple assumptions will probably need some tweaking
+  (when (string-match "[ \f\t\n\r\v]+" results)
+    (concat "(" (mapconcat #'litorgy-R-tale-or-results
+                           (split-string results) " ") ")"))
+  results)
 
 (provide 'litorgy-R)
 ;;; litorgy-R.el ends here

litorgy/litorgy-lisp.el

@@ -1,8 +1,8 @@
 ;;; litorgy-lisp.el --- litorgy functions for lisp code evaluation
 
-;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
+;; Copyright (C) 2009 Eric Schulte
 
-;; Author: Eric Schulte, Dan Davison, Austin F. Frank
+;; Author: Eric Schulte
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
@@ -36,10 +36,10 @@
 (defun litorgy-execute:emacs-lisp (body params)
   "Execute a block of emacs-lisp code with litorgy.  This
 function is called by `litorgy-execute-src-block'."
+  (message "executing emacs-lisp code block...")
   (save-window-excursion
     (let ((vars (litorgy-reference-variables params))
           (print-level nil) (print-length nil) results)
-      (message "executing emacs-lisp code block...")
       (setq results
             (eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) vars)
                      ,(read body))))

litorgy/litorgy-reference.el

@@ -100,12 +100,16 @@ representation of the value of the variable."
                    (t
                     (goto-char (point-min))
                     (setq direction 1)
-                    (unless (re-search-forward
-                             (concat "^#\\+TBLNAME:[ \t]*" (regexp-quote ref) "[ \t]*$") nil t)
-                      (setq id-loc (org-id-find name-or-id 'marker)
-                            buffer (marker-buffer id-loc)
-                            loc (marker-position id-loc))
-                      (move-marker id-loc nil))))
+                    (unless (let ((regexp (concat "^#\\+TBLNAME:[ \t]*"
+                                                  (regexp-quote ref) "[ \t]*$")))
+                              (or (re-search-forward regexp nil t)
+                                  (re-search-backward regexp nil t)))
+                      ;; ;; TODO: allow searching for table in other buffers
+                      ;; (setq id-loc (org-id-find ref 'marker)
+                      ;;       buffer (marker-buffer id-loc)
+                      ;;       loc (marker-position id-loc))
+                      ;; (move-marker id-loc nil)
+                      (error (format "table '%s' not found in this buffer" ref)))))
                   (while (not (org-at-table-p))
                     (forward-line direction)
                     (if (or (= (point) (point-min)) (= (point) (point-max)))

litorgy/litorgy-script.el

@@ -1,8 +1,8 @@
 ;;; litorgy-script.el --- litorgy functions for script execution
 
-;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
+;; Copyright (C) 2009 Eric Schulte
 
-;; Author: Eric Schulte, Dan Davison, Austin F. Frank
+;; Author: Eric Schulte
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
@@ -26,7 +26,7 @@
 
 ;;; Commentary:
 
-;; Litorgy support for evaluating shell, ruby, and python source code.
+;; Litorgy support for evaluating ruby, and python source code.
 
 ;;; Code:
 (require 'litorgy)
@@ -37,26 +37,69 @@
           (setq litorgy-interpreters (cons cmd litorgy-interpreters))
           (eval
            `(defun ,(intern (concat "litorgy-execute:" cmd)) (body params)
-              (concat "Evaluate a block of " ,cmd " script with litorgy.
-This function is called by `litorgy-execute-src-block'.")
+              ,(concat "Evaluate a block of " cmd " script with litorgy. This function is
+called by `litorgy-execute-src-block'.  This function is an
+automatically generated wrapper for `litorgy-script-execute'.")
               (litorgy-script-execute ,cmd body params))))
         cmds))
 
-(defcustom litorgy-script-interpreters '("sh" "bash" "zsh" "ruby" "python")
+(defcustom litorgy-script-interpreters '("ruby" "python")
   "List of interpreters of scripting languages which can be
 executed through litorgy."
   :group 'litorgy
   :set 'litorgy-script-add-interpreter)
 
 (defun litorgy-script-execute (cmd body params)
-  "Run CMD on BODY obeying any options set with PARAMS.
-TODO: currently the params part is not implemented"
-  (message (format "executing source block with %s..." cmd))
-  (with-temp-buffer
-    (insert body)
-    (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
-    (message "finished executing source block")
-    (buffer-string)))
+  "Run CMD on BODY obeying any options set with PARAMS."
+  (message (format "executing %s code block..." cmd))
+  (let ((vars (litorgy-reference-variables params)))
+    (save-window-excursion
+      (with-temp-buffer
+        (when (string= "ruby" cmd) (insert "def main\n"))
+        ;; define any variables
+        (mapcar
+         (lambda (pair)
+           (insert (format "%s=%s\n"
+                           (car pair)
+                           (litorgy-script-table-to-ruby/python (cdr pair)))))
+         vars)
+        (case (intern cmd)
+          ('ruby
+           (insert body)
+           (insert "\nend\n\nputs main.inspect\n"))
+          ('python
+           (insert "def main():\n")
+           (let ((body-lines (split-string body "[\n\r]+" t)))
+             (mapc
+              (lambda (line)
+                (insert (format "\t%s\n" line)))
+              (butlast body-lines))
+             (insert (format "\treturn %s\n" (car (last body-lines)))))
+           (insert "\nprint main()\n")))
+        (message (buffer-string))
+        (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
+        (litorgy-script-table-or-results (buffer-string))))))
+
+(defun litorgy-script-table-to-ruby/python (table)
+  "Convert an elisp table (nested lists) into a string of ruby
+source code specifying a table (nested arrays)."
+  (if (listp table)
+      (concat "[" (mapconcat #'litorgy-script-table-to-ruby/python table ", ") "]")
+    (format "%S" table)))
+
+(defun litorgy-script-table-or-results (results)
+  "If the results look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+  (when (string-match "^\\[.+\\]$" results)
+    (setq results
+          ;; somewhat hacky, but thanks to similarities between
+          ;; languages it seems to work
+          (read (replace-regexp-in-string
+                 "\\[" "(" (replace-regexp-in-string
+                            "\\]" ")" (replace-regexp-in-string
+                                       ", " " " (replace-regexp-in-string
+                                                 "'" "\"" results)))))))
+  results)
 
 (provide 'litorgy-script)
 ;;; litorgy-script.el ends here

litorgy/litorgy.el

@@ -151,21 +151,23 @@ form.  (language body header-arguments-alist)"
 current source block.  With optional argument REPLACE replace any
 existing results currently located after the source block."
   (if replace (litorgy-remove-result (listp result)))
-  (when (and (stringp result)
-             (not (or (string-equal (substring result -1) "\n")
-                      (string-equal (substring result -1) "\r"))))
-    (setq result (concat result "\n")))
-  (save-excursion
-    (re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2)
-    (if (stringp result)
-        (litorgy-examplize-region (point) (progn (insert result) (point)))
-      (progn
-        (insert ;; for now lets assume the result is a table if it's not a string
-         (concat (orgtbl-to-orgtbl
-                  (if (consp (car result)) result (list result))
-                  '(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
-        (forward-line -1)
-        (org-cycle)))))
+  (if (= (length result) 0)
+      (message "no result returned by source block")
+    (when (and (stringp result)
+               (not (or (string-equal (substring result -1) "\n")
+                        (string-equal (substring result -1) "\r"))))
+      (setq result (concat result "\n")))
+    (save-excursion
+      (re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2)
+      (if (stringp result)
+          (litorgy-examplize-region (point) (progn (insert result) (point)))
+        (progn
+          (insert ;; for now lets assume the result is a table if it's not a string
+           (concat (orgtbl-to-orgtbl
+                    (if (consp (car result)) result (list result))
+                    '(:fmt (lambda (cell) (format "%S" cell)))) "\n"))
+          (forward-line -1)
+          (org-cycle))))))
 
 (defun litorgy-remove-result (&optional table)
   "Remove the result following the current source block.  If

rorg.org

@@ -751,11 +751,14 @@ out...
    finally it should insert the transposed table into the buffer
    immediately following the block
 
+*** Emacs lisp
+
 #+begin_src emacs-lisp
 (defun transpose (table)
   (apply #'mapcar* #'list table))
 #+end_src
 
+#+TBLNAME: sandbox
 | 1 |       2 | 3 |
 | 4 | schulte | 6 |
 
@@ -763,6 +766,56 @@ out...
 (transpose table)
 #+end_src
 
+#+begin_src emacs-lisp :var table=sandbox :replace t
+(transpose table)
+#+end_src
+
+*** Ruby and Python
+
+#+begin_src ruby :var table=sandbox :replace t
+table.first.join(" - ")
+#+end_src
+
+: "1 - 2 - 3"
+
+#+begin_src python :var table=sandbox :replace t
+table[0]
+#+end_src
+
+| 1 | 2 | 3 |
+
+#+begin_src ruby :var table=sandbox :replace t
+table
+#+end_src
+
+| 1 |         2 | 3 |
+| 4 | "schulte" | 6 |
+
+#+begin_src python :var table=sandbox :replace t
+table
+#+end_src
+
+| 1 |         2 | 3 |
+| 4 | "schulte" | 6 |
+
+*** R
+
+#+begin_src R :replace t
+a <- 9
+b <- 8
+
+#+end_src
+
+#+begin_src R :replace t
+x <- c(rnorm(10, mean=-3, sd=1), rnorm(10, mean=3, sd=1))
+x
+#+end_src
+
+: -2.059712 -1.299807 -2.518628 -4.319525 -1.944779 -5.345708 -3.921314
+: -2.841109 -0.963475 -2.465979  4.092037  1.299202  1.476687  2.128594
+: 3.200629  1.990952  1.888890  3.561541  3.818319  1.969161
+
+
 
 * COMMENT Commentary
 I'm seeing this as like commit notes, and a place for less formal