mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-12-18 10:17:03 +00:00
Merge branch 'master' of git@github.com:eschulte/rorg
This commit is contained in:
Dan Davison
commit
d14690e4cf
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))))
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
53
rorg.org
53
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user