rename litorgy to org-babel

This commit is contained in:
Eric Schulte 2009-05-24 13:40:07 -07:00
commit 2b9b2ee7a3
10 changed files with 282 additions and 282 deletions

View File

@ -1,4 +1,4 @@
;;; litorgy-R.el --- litorgy functions for R code evaluation
;;; org-babel-R.el --- org-babel functions for R code evaluation
;; Copyright (C) 2009 Eric Schulte
@ -26,56 +26,56 @@
;;; Commentary:
;; Litorgy support for evaluating R code
;; Org-Babel support for evaluating R code
;;; Code:
(require 'litorgy)
(require 'org-babel)
(litorgy-add-interpreter "R")
(org-babel-add-interpreter "R")
(defvar litorgy-R-func-name "litorgy_R_main"
(defvar org-babel-R-func-name "org-babel_R_main"
"This is the main function which wraps each R source code
block.")
(defun litorgy-execute:R (body params)
"Execute a block of R code with litorgy. This function is
called by `litorgy-execute-src-block'."
(defun org-babel-execute:R (body params)
"Execute a block of R code with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing R source code block...")
(save-window-excursion
(let ((vars (litorgy-ref-variables params))
(let ((vars (org-babel-ref-variables params))
results)
(litorgy-R-initiate-R-buffer)
(mapc (lambda (pair) (litorgy-R-assign-elisp (car pair) (cdr pair))) vars)
(litorgy-R-input-command
(format "%s <- function ()\n{\n%s\n}" litorgy-R-func-name body))
(litorgy-R-to-elisp litorgy-R-func-name))))
(org-babel-R-initiate-R-buffer)
(mapc (lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair))) vars)
(org-babel-R-input-command
(format "%s <- function ()\n{\n%s\n}" org-babel-R-func-name body))
(org-babel-R-to-elisp org-babel-R-func-name))))
(defun litorgy-R-quote-tsv-field (s)
(defun org-babel-R-quote-tsv-field (s)
"Quote field S for export to R."
(if (stringp s)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
(format "%S" s)))
(defun litorgy-R-assign-elisp (name value)
(defun org-babel-R-assign-elisp (name value)
"Read the elisp VALUE into a variable named NAME in the current
R process in `litorgy-R-buffer'."
(unless litorgy-R-buffer (error "No active R buffer"))
(litorgy-R-input-command
R process in `org-babel-R-buffer'."
(unless org-babel-R-buffer (error "No active R buffer"))
(org-babel-R-input-command
(if (listp value)
(let ((transition-file (make-temp-file "litorgy-R-import")))
(let ((transition-file (make-temp-file "org-babel-R-import")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file
(insert (orgtbl-to-tsv value '(:fmt litorgy-R-quote-tsv-field)))
(insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
(insert "\n"))
(format "%s <- read.table(\"%s\", sep=\"\\t\", as.is=TRUE)" name transition-file))
(format "%s <- %s" name (litorgy-R-quote-tsv-field value)))))
(format "%s <- %s" name (org-babel-R-quote-tsv-field value)))))
(defun litorgy-R-to-elisp (func-name)
(defun org-babel-R-to-elisp (func-name)
"Return the result of calling the function named FUNC-NAME in
`litorgy-R-buffer' as Emacs lisp."
(let ((tmp-file (make-temp-file "litorgy-R")) result)
(litorgy-R-input-command
`org-babel-R-buffer' as Emacs lisp."
(let ((tmp-file (make-temp-file "org-babel-R")) result)
(org-babel-R-input-command
(format "write.table(%s(), \"%s\", , ,\"\\t\", ,\"nil\", , FALSE, FALSE)" func-name tmp-file))
(with-temp-buffer
(message "before condition")
@ -84,7 +84,7 @@ R process in `litorgy-R-buffer'."
(org-table-import tmp-file nil)
(delete-file tmp-file)
(setq result (mapcar (lambda (row)
(mapcar #'litorgy-R-read row))
(mapcar #'org-babel-R-read row))
(org-table-to-lisp))))
(error nil))
(message "after condition")
@ -96,58 +96,58 @@ R process in `litorgy-R-buffer'."
(car result))
result))))
(defun litorgy-R-read (cell)
(defun org-babel-R-read (cell)
"Strip nested \"s from around strings in exported R values."
(litorgy-read (or (and (stringp cell)
(org-babel-read (or (and (stringp cell)
(string-match "\\\"\\(.+\\)\\\"" cell)
(match-string 1 cell))
cell)))
;; functions for evaluation of R code
(defvar litorgy-R-buffer nil
(defvar org-babel-R-buffer nil
"Holds the buffer for the current R process")
(defun litorgy-R-initiate-R-buffer ()
(defun org-babel-R-initiate-R-buffer ()
"If there is not a current R process then create one."
;; DED: Ideally I think we should use ESS mechanisms for this sort
;; of thing. See ess-force-buffer-current.
(unless (and (buffer-live-p litorgy-R-buffer) (get-buffer litorgy-R-buffer))
(unless (and (buffer-live-p org-babel-R-buffer) (get-buffer org-babel-R-buffer))
(save-excursion
(R)
(setf litorgy-R-buffer (current-buffer))
(litorgy-R-wait-for-output)
(litorgy-R-input-command ""))))
(setf org-babel-R-buffer (current-buffer))
(org-babel-R-wait-for-output)
(org-babel-R-input-command ""))))
(defun litorgy-R-command-to-string (command)
(defun org-babel-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))
(org-babel-R-input-command command)
(org-babel-R-last-output))
(defun litorgy-R-input-command (command)
"Pass COMMAND to the R process running in `litorgy-R-buffer'."
(defun org-babel-R-input-command (command)
"Pass COMMAND to the R process running in `org-babel-R-buffer'."
(save-excursion
(save-match-data
(set-buffer litorgy-R-buffer)
(set-buffer org-babel-R-buffer)
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert command)
(comint-send-input)
(litorgy-R-wait-for-output))))
(org-babel-R-wait-for-output))))
(defun litorgy-R-wait-for-output ()
(defun org-babel-R-wait-for-output ()
"Wait until output arrives"
(save-excursion
(save-match-data
(set-buffer litorgy-R-buffer)
(set-buffer org-babel-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 ()
(defun org-babel-R-last-output ()
"Return the last R output as a string"
(save-excursion
(save-match-data
(set-buffer litorgy-R-buffer)
(set-buffer org-babel-R-buffer)
(goto-char (process-mark (get-buffer-process (current-buffer))))
(forward-line 0)
(let ((raw (buffer-substring comint-last-input-end (- (point) 1)))
@ -166,5 +166,5 @@ R process in `litorgy-R-buffer'."
;; drop first, because it's the last line of input
(cdr (split-string raw "[\n\r]")))) "\n")))))
(provide 'litorgy-R)
;;; litorgy-R.el ends here
(provide 'org-babel-R)
;;; org-babel-R.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-exp.el --- Exportation of litorgy source blocks
;;; org-babel-exp.el --- Exportation of org-babel source blocks
;; Copyright (C) 2009 Eric Schulte
@ -26,15 +26,15 @@
;;; Commentary:
;; for more information see the comments in litorgy.el
;; for more information see the comments in org-babel.el
;;; Code:
(require 'litorgy)
(require 'org-babel)
(require 'org-exp-blocks)
(add-to-list 'org-export-blocks '(src litorgy-exp-src-blocks))
(add-to-list 'org-export-interblocks '(src litorgy-exp-inline-src-blocks))
(add-to-list 'org-export-blocks '(src org-babel-exp-src-blocks))
(add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks))
(defun litorgy-exp-src-blocks (body &rest headers)
(defun org-babel-exp-src-blocks (body &rest headers)
"Process src block for export. Depending on the 'export'
headers argument in replace the source code block with...
@ -47,46 +47,46 @@ results - process the block and replace it with the results of
none ----- do not display either code or results upon export"
(interactive)
(unless headers (error "litorgy can't process a source block without knowing the source code"))
(message "litorgy processing...")
(unless headers (error "org-babel can't process a source block without knowing the source code"))
(message "org-babel processing...")
(let ((lang (car headers))
(params (litorgy-parse-header-arguments (mapconcat #'identity (cdr headers) " "))))
(litorgy-exp-do-export lang body params)))
(params (org-babel-parse-header-arguments (mapconcat #'identity (cdr headers) " "))))
(org-babel-exp-do-export lang body params)))
(defun litorgy-exp-inline-src-blocks (start end)
(defun org-babel-exp-inline-src-blocks (start end)
"Process inline src blocks between START and END for export.
See `litorgy-exp-src-blocks' for export options, currently the
options and are taken from `litorgy-defualt-inline-header-args'."
See `org-babel-exp-src-blocks' for export options, currently the
options and are taken from `org-babel-defualt-inline-header-args'."
(interactive)
(save-excursion
(goto-char start)
(while (and (< (point) end) (re-search-forward litorgy-inline-src-block-regexp end t))
(let* ((info (save-match-data (litorgy-parse-inline-src-block-match)))
(while (and (< (point) end) (re-search-forward org-babel-inline-src-block-regexp end t))
(let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
(replacement (save-match-data
(litorgy-exp-do-export (first info) (second info) (third info) t))))
(org-babel-exp-do-export (first info) (second info) (third info) t))))
(setf end (+ end (- (length replacement)
(+ 6 (length (first info)) (length (second info))))))
(replace-match replacement t t)))))
(defun litorgy-exp-do-export (lang body params &optional inline)
(defun org-babel-exp-do-export (lang body params &optional inline)
(case (intern (or (cdr (assoc :exports params)) "code"))
('none "")
('code (litorgy-exp-code body lang params inline))
('results (litorgy-exp-results body lang params inline))
('both (concat (litorgy-exp-code body lang params inline)
('code (org-babel-exp-code body lang params inline))
('results (org-babel-exp-results body lang params inline))
('both (concat (org-babel-exp-code body lang params inline)
"\n\n"
(litorgy-exp-results body lang params inline)))))
(org-babel-exp-results body lang params inline)))))
(defun litorgy-exp-code (body lang params &optional inline)
(defun org-babel-exp-code (body lang params &optional inline)
(if inline
(format "=%s=" body)
(format "#+BEGIN_SRC %s\n%s%s\n#+END_SRC" lang body
(if (string-match "\n$" body) "" "\n"))))
(defun litorgy-exp-results (body lang params &optional inline)
(let* ((cmd (intern (concat "litorgy-execute:" lang)))
(defun org-babel-exp-results (body lang params &optional inline)
(let* ((cmd (intern (concat "org-babel-execute:" lang)))
(result (funcall cmd body params))
(result-as-org (litorgy-result-to-org-string result)))
(result-as-org (org-babel-result-to-org-string result)))
(if inline
(format "=%s=" result)
(if (stringp result)
@ -94,5 +94,5 @@ options and are taken from `litorgy-defualt-inline-header-args'."
(if (string-match "\n$" body) "" "\n"))
result-as-org))))
(provide 'litorgy-exp)
;;; litorgy-exp.el ends here
(provide 'org-babel-exp)
;;; org-babel-exp.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-init.el --- loads litorgy
;;; org-babel-init.el --- loads org-babel
;; Copyright (C) 2009 Eric Schulte
@ -26,23 +26,23 @@
;;; Commentary:
;; for more information see the comments in litorgy.el
;; for more information see the comments in org-babel.el
;;; Code:
(require 'org)
(require 'org-exp-blocks)
(load "htmlize.el") ;; other versions of htmlize can cause export problems
(require 'litorgy)
(require 'litorgy-ref)
(require 'litorgy-ui)
(require 'litorgy-exp)
(require 'litorgy-table)
(require 'org-babel)
(require 'org-babel-ref)
(require 'org-babel-ui)
(require 'org-babel-exp)
(require 'org-babel-table)
;; language specific files
(require 'litorgy-script)
(require 'litorgy-shell)
(require 'litorgy-lisp)
(require 'litorgy-R)
(require 'org-babel-script)
(require 'org-babel-shell)
(require 'org-babel-lisp)
(require 'org-babel-R)
(provide 'litorgy-init)
;;; litorgy-init.el ends here
(provide 'org-babel-init)
;;; org-babel-init.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-lisp.el --- litorgy functions for lisp code evaluation
;;; org-babel-lisp.el --- org-babel functions for lisp code evaluation
;; Copyright (C) 2009 Eric Schulte
@ -26,24 +26,24 @@
;;; Commentary:
;; Litorgy support for evaluating lisp code
;; Org-Babel support for evaluating lisp code
;;; Code:
(require 'litorgy)
(require 'org-babel)
(litorgy-add-interpreter "emacs-lisp")
(org-babel-add-interpreter "emacs-lisp")
(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'."
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with org-babel. This
function is called by `org-babel-execute-src-block'."
(message "executing emacs-lisp code block...")
(save-window-excursion
(let ((vars (litorgy-ref-variables params))
(let ((vars (org-babel-ref-variables params))
(print-level nil) (print-length nil) results)
(setq results
(eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) vars)
,(read (concat "(progn " body ")")))))
results)))
(provide 'litorgy-lisp)
;;; litorgy-lisp.el ends here
(provide 'org-babel-lisp)
;;; org-babel-lisp.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-ref.el --- litorgical functions for referencing external data
;;; org-babel-ref.el --- org-babel functions for referencing external data
;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
@ -27,7 +27,7 @@
;;; Commentary:
;; Functions for referencing data from the header arguments of a
;; litorgical block. The syntax of such a reference should be
;; org-babel block. The syntax of such a reference should be
;;
;; #+VAR: variable-name=file:resource-id
;;
@ -44,7 +44,7 @@
;;
;; #+TBLNAME: sandbox
;; | 1 | 2 | 3 |
;; | 4 | litorgy | 6 |
;; | 4 | org-babel | 6 |
;;
;; #+begin_src emacs-lisp :var table=sandbox
;; (message table)
@ -52,19 +52,19 @@
;;
;;; Code:
(require 'litorgy)
(require 'org-babel)
(defun litorgy-ref-variables (params)
(defun org-babel-ref-variables (params)
"Takes a parameter alist, and return an alist of variable
names, and the emacs-lisp representation of the related value."
(mapcar #'litorgy-ref-parse
(mapcar #'org-babel-ref-parse
(delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params))))
(defun litorgy-ref-parse (assignment)
(defun org-babel-ref-parse (assignment)
"Parse a variable ASSIGNMENT in a header argument. If the
right hand side of the assignment has a literal value return that
value, otherwise interpret as a reference to an external resource
and find it's value using `litorgy-ref-resolve-reference'.
and find it's value using `org-babel-ref-resolve-reference'.
Return a list with two elements. The first element of the list
will be the name of the variable, and the second will be an
emacs-lisp representation of the value of the variable."
@ -72,21 +72,21 @@ emacs-lisp representation of the value of the variable."
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
(or (litorgy-ref-literal ref)
(litorgy-ref-resolve-reference ref))))))
(or (org-babel-ref-literal ref)
(org-babel-ref-resolve-reference ref))))))
(defun litorgy-ref-literal (ref)
(defun org-babel-ref-literal (ref)
"Determine if the right side of a header argument variable
assignment is a literal value or is a reference to some external
resource. If REF is literal then return it's value, otherwise
return nil."
(let ((out (litorgy-read ref)))
(let ((out (org-babel-read ref)))
(if (equal out ref)
(if (string-match "\"\\(.+\\)\"" ref)
(read ref))
out)))
(defun litorgy-ref-resolve-reference (ref)
(defun org-babel-ref-resolve-reference (ref)
"Resolve the reference and return it's value"
(save-excursion
(let ((case-fold-search t)
@ -120,7 +120,7 @@ return nil."
;; (move-marker id-loc nil)
(progn (message (format "reference '%s' not found in this buffer" ref))
(error (format "reference '%s' not found in this buffer" ref))))
(while (not (setq type (litorgy-ref-at-ref-p)))
(while (not (setq type (org-babel-ref-at-ref-p)))
(forward-line 1)
(beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max)))
@ -128,18 +128,18 @@ return nil."
(case type
('table
(mapcar (lambda (row)
(mapcar #'litorgy-read row))
(mapcar #'org-babel-read row))
(org-table-to-lisp)))
('source-block
(setq result (litorgy-execute-src-block t nil args))
(setq result (org-babel-execute-src-block t nil args))
(if (symbolp result) (format "%S" result) result))))))
(defun litorgy-ref-at-ref-p ()
(defun org-babel-ref-at-ref-p ()
"Return the type of reference located at point or nil of none
of the supported reference types are found. Supported reference
types are tables and source blocks."
(cond ((org-at-table-p) 'table)
((looking-at "^#\\+BEGIN_SRC") 'source-block)))
(provide 'litorgy-ref)
;;; litorgy-ref.el ends here
(provide 'org-babel-ref)
;;; org-babel-ref.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-script.el --- litorgy functions for scripting languages
;;; org-babel-script.el --- org-babel functions for scripting languages
;; Copyright (C) 2009 Eric Schulte
@ -26,24 +26,24 @@
;;; Commentary:
;; Litorgy support for evaluating ruby, and python source code.
;; Org-Babel support for evaluating ruby, and python source code.
;;; Code:
(require 'litorgy)
(require 'org-babel)
(defun litorgy-script-add-interpreter (var cmds)
(defun org-babel-script-add-interpreter (var cmds)
(set-default var cmds)
(mapc (lambda (cmd)
(setq litorgy-interpreters (cons cmd litorgy-interpreters))
(setq org-babel-interpreters (cons cmd org-babel-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'. This function is an
automatically generated wrapper for `litorgy-script-execute'.")
(litorgy-script-execute ,cmd body params))))
`(defun ,(intern (concat "org-babel-execute:" cmd)) (body params)
,(concat "Evaluate a block of " cmd " script with org-babel. This function is
called by `org-babel-execute-src-block'. This function is an
automatically generated wrapper for `org-babel-script-execute'.")
(org-babel-script-execute ,cmd body params))))
cmds))
(defvar litorgy-script-ruby-wrapper-method
(defvar org-babel-script-ruby-wrapper-method
"
def main
%s
@ -52,36 +52,36 @@ results = main()
puts (results.class == String) ? results : results.inspect
")
(defvar litorgy-script-python-wrapper-method
(defvar org-babel-script-python-wrapper-method
"
def main():
%s
print main()")
(defcustom litorgy-script-interpreters '("ruby" "python")
(defcustom org-babel-script-interpreters '("ruby" "python")
"List of interpreters of scripting languages which can be
executed through litorgy."
:group 'litorgy
:set 'litorgy-script-add-interpreter)
executed through org-babel."
:group 'org-babel
:set 'org-babel-script-add-interpreter)
(defun litorgy-script-execute (cmd body params)
(defun org-babel-script-execute (cmd body params)
"Run CMD on BODY obeying any options set with PARAMS."
(message (format "executing %s code block..." cmd))
(let ((vars (litorgy-ref-variables params)))
(let ((vars (org-babel-ref-variables params)))
(save-window-excursion
(with-temp-buffer
(insert
(format
(case (intern cmd)
('ruby litorgy-script-ruby-wrapper-method)
('python litorgy-script-python-wrapper-method))
('ruby org-babel-script-ruby-wrapper-method)
('python org-babel-script-python-wrapper-method))
(concat
(mapconcat ;; define any variables
(lambda (pair)
(format "\t%s=%s"
(car pair)
(litorgy-script-var-to-ruby/python (cdr pair))))
(org-babel-script-var-to-ruby/python (cdr pair))))
vars "\n")
"\n"
(let ((body-lines (split-string body "[\n\r]+" t)))
@ -91,30 +91,30 @@ executed through litorgy."
;; (message (buffer-substring (point-min) (point-max))) ;; debug script
(shell-command-on-region (point-min) (point-max) cmd nil 'replace)
;; (message (format "shell output = %s" (buffer-string))) ;; debug results
(litorgy-script-table-or-results (buffer-string))))))
(org-babel-script-table-or-results (buffer-string))))))
(defun litorgy-script-var-to-ruby/python (var)
(defun org-babel-script-var-to-ruby/python (var)
"Convert an elisp var into a string of ruby or python source
code specifying a var of the same value."
(if (listp var)
(concat "[" (mapconcat #'litorgy-script-var-to-ruby/python var ", ") "]")
(concat "[" (mapconcat #'org-babel-script-var-to-ruby/python var ", ") "]")
(format "%S" var)))
(defun litorgy-script-table-or-results (results)
(defun org-babel-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."
(setq results (litorgy-chomp results))
(litorgy-read
(setq results (org-babel-chomp results))
(org-babel-read
(if (string-match "^\\[.+\\]$" results)
;; somewhat hacky, but thanks to similarities between languages
;; it seems to work
(litorgy-read
(org-babel-read
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string
"'" "\"" results)))))
(litorgy-chomp results))))
(org-babel-chomp results))))
(provide 'litorgy-script)
;;; litorgy-script.el ends here
(provide 'org-babel-script)
;;; org-babel-script.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-shell.el --- litorgy functions for shell execution
;;; org-babel-shell.el --- org-babel functions for shell execution
;; Copyright (C) 2009 Eric Schulte
@ -26,50 +26,50 @@
;;; Commentary:
;; Litorgy support for evaluating sh, bash, and zsh shells
;; Org-Babel support for evaluating sh, bash, and zsh shells
;;; Code:
(require 'litorgy)
(require 'org-babel)
(defun litorgy-shell-add-interpreter (var cmds)
(defun org-babel-shell-add-interpreter (var cmds)
(set-default var cmds)
(mapc (lambda (cmd)
(setq litorgy-interpreters (cons cmd litorgy-interpreters))
(setq org-babel-interpreters (cons cmd org-babel-interpreters))
(eval
`(defun ,(intern (concat "litorgy-execute:" cmd)) (body params)
,(concat "Evaluate a block of " cmd " shell with litorgy. This function is
called by `litorgy-execute-src-block'. This function is an
automatically generated wrapper for `litorgy-shell-execute'.")
(litorgy-shell-execute ,cmd body params))))
`(defun ,(intern (concat "org-babel-execute:" cmd)) (body params)
,(concat "Evaluate a block of " cmd " shell with org-babel. This function is
called by `org-babel-execute-src-block'. This function is an
automatically generated wrapper for `org-babel-shell-execute'.")
(org-babel-shell-execute ,cmd body params))))
cmds))
(defcustom litorgy-shell-interpreters '("sh" "bash" "zsh")
(defcustom org-babel-shell-interpreters '("sh" "bash" "zsh")
"List of interpreters of shelling languages which can be
executed through litorgy."
:group 'litorgy
:set 'litorgy-shell-add-interpreter)
executed through org-babel."
:group 'org-babel
:set 'org-babel-shell-add-interpreter)
(defun litorgy-shell-execute (cmd body params)
(defun org-babel-shell-execute (cmd body params)
"Run CMD on BODY obeying any options set with PARAMS."
(message (format "executing %s code block..." cmd))
(let ((vars (litorgy-ref-variables params)))
(let ((vars (org-babel-ref-variables params)))
(save-window-excursion
(with-temp-buffer
(if (> (length vars) 0)
(error "currently no support for passing variables to shells"))
(insert body)
(shell-command-on-region (point-min) (point-max) cmd nil 'replace)
(litorgy-shell-to-elisp (buffer-string))))))
(org-babel-shell-to-elisp (buffer-string))))))
(defun litorgy-shell-to-elisp (result)
(let ((tmp-file (make-temp-file "litorgy-shell")))
(defun org-babel-shell-to-elisp (result)
(let ((tmp-file (make-temp-file "org-babel-shell")))
(with-temp-file tmp-file
(insert result))
(with-temp-buffer
(org-table-import tmp-file nil)
(delete-file tmp-file)
(setq result (mapcar (lambda (row)
(mapcar #'litorgy-read row))
(mapcar #'org-babel-read row))
(org-table-to-lisp)))
(if (null (cdr result)) ;; if result is trivial vector, then scalarize it
(if (consp (car result))
@ -79,5 +79,5 @@ executed through litorgy."
(car result))
result))))
(provide 'litorgy-shell)
;;; litorgy-shell.el ends here
(provide 'org-babel-shell)
;;; org-babel-shell.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-table.el --- integration for calling litorgical functions from tables
;;; org-babel-table.el --- integration for calling org-babel functions from tables
;; Copyright (C) 2009 Eric Schulte
@ -53,9 +53,9 @@
;; #+TBLFM: $2='(sbe 'fibbd (n $1))
;;; Code:
(require 'litorgy)
(require 'org-babel)
(defun litorgy-table-truncate-at-newline (string)
(defun org-babel-table-truncate-at-newline (string)
(if (and (stringp string) (string-match "[\n\r]" string))
(concat (substring string 0 (match-beginning 0)) "...")
string))
@ -74,9 +74,9 @@ source code block.
results
#+end_src"
(unless (stringp source-block) (setq source-block (symbol-name source-block)))
(litorgy-table-truncate-at-newline ;; org-table cells can't be multi-line
(org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line
(if (and source-block (> (length source-block) 0))
(let ((params (eval `(litorgy-parse-header-arguments
(let ((params (eval `(org-babel-parse-header-arguments
(concat ":var results="
,source-block
"("
@ -84,8 +84,8 @@ results
(format "%S=%s" (first var-spec) (second var-spec)))
',variables ", ")
")")))))
(litorgy-execute-src-block t (list "emacs-lisp" "results" params)))
(org-babel-execute-src-block t (list "emacs-lisp" "results" params)))
"")))
(provide 'litorgy-table)
;;; litorgy-table.el ends here
(provide 'org-babel-table)
;;; org-babel-table.el ends here

View File

@ -1,4 +1,4 @@
;;; litorgy-ui.el --- UI elements for litorgy
;;; org-babel-ui.el --- UI elements for org-babel
;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
@ -26,44 +26,44 @@
;;; Commentary:
;; UI elements of litorgy
;; UI elements of org-babel
;; - code folding
;; - marking working code blocks
;;; Code:
(require 'litorgy)
(require 'org-babel)
(defun litorgy-ui-src-block-cycle-maybe ()
"Detect if this is context for a litorgical src-block and if so
then run `litorgy-execute-src-block'."
(defun org-babel-ui-src-block-cycle-maybe ()
"Detect if this is context for a org-babel src-block and if so
then run `org-babel-execute-src-block'."
(let ((case-fold-search t))
(if (save-excursion
(beginning-of-line 1)
(looking-at litorgy-src-block-regexp))
(progn (call-interactively 'litorgy-ui-src-block-cycle)
(looking-at org-babel-src-block-regexp))
(progn (call-interactively 'org-babel-ui-src-block-cycle)
t) ;; to signal that we took action
nil))) ;; to signal that we did not
(defun litorgy-ui-src-block-cycle ()
(defun org-babel-ui-src-block-cycle ()
"Cycle the visibility of the current source code block"
(interactive)
;; should really do this once in an (org-mode hook)
(add-to-invisibility-spec '(litorgy-ui . t))
(add-to-invisibility-spec '(org-babel-ui . t))
(message "trying out source block")
(save-excursion
(beginning-of-line)
(if (re-search-forward litorgy-src-block-regexp nil t)
(if (re-search-forward org-babel-src-block-regexp nil t)
(let ((start (- (match-beginning 4) 1)) ;; beginning of body
(end (match-end 0))) ;; end of entire body
(if (memq t (mapcar (lambda (overlay)
(eq (overlay-get overlay 'invisible) 'litorgy-ui))
(eq (overlay-get overlay 'invisible) 'org-babel-ui))
(overlays-at start)))
(remove-overlays start end 'invisible 'litorgy-ui)
(overlay-put (make-overlay start end) 'invisible 'litorgy-ui)))
(remove-overlays start end 'invisible 'org-babel-ui)
(overlay-put (make-overlay start end) 'invisible 'org-babel-ui)))
(error "not looking at a source block"))))
;; org-tab-after-check-for-cycling-hook
(add-hook 'org-tab-first-hook 'litorgy-ui-src-block-cycle-maybe)
(add-hook 'org-tab-first-hook 'org-babel-ui-src-block-cycle-maybe)
(provide 'litorgy-ui)
;;; litorgy-ui ends here
(provide 'org-babel-ui)
;;; org-babel-ui ends here

View File

@ -1,4 +1,4 @@
;;; litorgy.el --- literate programming in org-mode
;;; org-babel.el --- literate programming in org-mode
;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
@ -31,50 +31,50 @@
;;; Code:
(require 'org)
(defun litorgy-execute-src-block-maybe ()
"Detect if this is context for a litorgical src-block and if so
then run `litorgy-execute-src-block'."
(defun org-babel-execute-src-block-maybe ()
"Detect if this is context for a org-babel src-block and if so
then run `org-babel-execute-src-block'."
(interactive)
(let ((info (litorgy-get-src-block-info)))
(if info (progn (litorgy-execute-src-block current-prefix-arg info) t) nil)))
(let ((info (org-babel-get-src-block-info)))
(if info (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)))
(add-hook 'org-ctrl-c-ctrl-c-hook 'litorgy-execute-src-block-maybe)
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe)
(defvar litorgy-default-header-args '()
(defvar org-babel-default-header-args '()
"Default arguments to use when evaluating a source block.")
(defvar litorgy-default-inline-header-args '((:results . "silent") (:exports . "results"))
(defvar org-babel-default-inline-header-args '((:results . "silent") (:exports . "results"))
"Default arguments to use when evaluating an inline source block.")
(defvar litorgy-src-block-regexp nil
"Regexp used to test when inside of a litorgical src-block")
(defvar org-babel-src-block-regexp nil
"Regexp used to test when inside of a org-babel src-block")
(defvar litorgy-inline-src-block-regexp nil
"Regexp used to test when on an inline litorgical src-block")
(defvar org-babel-inline-src-block-regexp nil
"Regexp used to test when on an inline org-babel src-block")
(defun litorgy-set-interpreters (var value)
(defun org-babel-set-interpreters (var value)
(set-default var value)
(setq litorgy-src-block-regexp
(setq org-babel-src-block-regexp
(concat "#\\+begin_src \\("
(mapconcat 'regexp-quote value "\\|")
"\\)[ \t]*"
"\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments
"\\([^\000]+?\\)#\\+end_src"))
(setq litorgy-inline-src-block-regexp
(setq org-babel-inline-src-block-regexp
(concat "src_\\("
(mapconcat 'regexp-quote value "\\|")
"\\)"
"\\(\\|\\[\\(.*\\)\\]\\)"
"{\\([^\n]+\\)}")))
(defun litorgy-add-interpreter (interpreter)
"Add INTERPRETER to `litorgy-interpreters' and update
`litorgy-src-block-regexp' appropriately."
(unless (member interpreter litorgy-interpreters)
(setq litorgy-interpreters (cons interpreter litorgy-interpreters))
(litorgy-set-interpreters 'litorgy-interpreters litorgy-interpreters)))
(defun org-babel-add-interpreter (interpreter)
"Add INTERPRETER to `org-babel-interpreters' and update
`org-babel-src-block-regexp' appropriately."
(unless (member interpreter org-babel-interpreters)
(setq org-babel-interpreters (cons interpreter org-babel-interpreters))
(org-babel-set-interpreters 'org-babel-interpreters org-babel-interpreters)))
(defcustom litorgy-interpreters '()
(defcustom org-babel-interpreters '()
"Interpreters allows for evaluation tags.
This is a list of program names (as strings) that can evaluate code and
insert the output into an Org-mode buffer. Valid choices are
@ -86,12 +86,12 @@ perl The perl interpreter
python The python interpreter
ruby The ruby interpreter
The source block regexp `litorgy-src-block-regexp' is updated
The source block regexp `org-babel-src-block-regexp' is updated
when a new interpreter is added to this list through the
customize interface. To add interpreters to this variable from
lisp code use the `litorgy-add-interpreter' function."
:group 'litorgy
:set 'litorgy-set-interpreters
lisp code use the `org-babel-add-interpreter' function."
:group 'org-babel
:set 'org-babel-set-interpreters
:type '(set :greedy t
(const "R")
(const "emacs-lisp")
@ -101,7 +101,7 @@ lisp code use the `litorgy-add-interpreter' function."
(const "ruby")))
;;; functions
(defun litorgy-execute-src-block (&optional arg info params)
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block, and dump the results
into the buffer immediately following the block. Results are
commented by `org-toggle-fixed-width-section'. With optional
@ -110,20 +110,20 @@ results in raw elisp (this is useful for automated execution of a
source block).
Optionally supply a value for INFO in the form returned by
`litorgy-get-src-block-info'.
`org-babel-get-src-block-info'.
Optionally supply a value for PARAMS which will be merged with
the header arguments specified at the source code block."
(interactive)
(let* ((info (or info (litorgy-get-src-block-info)))
(let* ((info (or info (org-babel-get-src-block-info)))
(lang (first info))
(body (second info))
(params (org-combine-plists (third info) params))
(cmd (intern (concat "litorgy-execute:" lang)))
(cmd (intern (concat "org-babel-execute:" lang)))
result)
;; (message (format "params=%S" params)) ;; debugging statement
(unless (member lang litorgy-interpreters)
(error "Language is not in `litorgy-interpreters': %s" lang))
(unless (member lang org-babel-interpreters)
(error "Language is not in `org-babel-interpreters': %s" lang))
(setq result (funcall cmd body params))
;; possibly force result into a vector
(if (and (not (listp result)) (cdr (assoc :results params))
@ -131,60 +131,60 @@ the header arguments specified at the source code block."
(setq result (list result)))
(if arg
(message (format "%S" result))
(litorgy-insert-result result (cdr (assoc :results params))))
(org-babel-insert-result result (cdr (assoc :results params))))
result))
(defun litorgy-eval-buffer (&optional arg)
(defun org-babel-eval-buffer (&optional arg)
"Replace EVAL snippets in the entire buffer."
(interactive "P")
(save-excursion
(goto-char (point-min))
(while (re-search-forward litorgy-regexp nil t)
(litorgy-eval-src-block arg))))
(while (re-search-forward org-babel-regexp nil t)
(org-babel-eval-src-block arg))))
(defun litorgy-eval-subtree (&optional arg)
(defun org-babel-eval-subtree (&optional arg)
"Replace EVAL snippets in the entire subtree."
(interactive "P")
(save-excursion
(org-narrow-to-subtree)
(litorgy-eval-buffer)
(org-babel-eval-buffer)
(widen)))
(defun litorgy-get-src-block-name ()
(defun org-babel-get-src-block-name ()
"Return the name of the current source block if one exists"
(let ((case-fold-search t))
(save-excursion
(goto-char (litorgy-where-is-src-block-head))
(goto-char (org-babel-where-is-src-block-head))
(if (save-excursion (forward-line -1)
(looking-at "#\\+srcname:[ \f\t\n\r\v]*\\([^ \f\t\n\r\v]+\\)"))
(litorgy-clean-text-properties (match-string 1))))))
(org-babel-clean-text-properties (match-string 1))))))
(defun litorgy-get-src-block-info ()
(defun org-babel-get-src-block-info ()
"Return the information of the current source block as a list
of the following form. (language body header-arguments-alist)"
(let ((case-fold-search t) head)
(if (setq head (litorgy-where-is-src-block-head))
(save-excursion (goto-char head) (litorgy-parse-src-block-match))
(if (setq head (org-babel-where-is-src-block-head))
(save-excursion (goto-char head) (org-babel-parse-src-block-match))
(if (save-excursion ;; inline source block
(re-search-backward "[ \f\t\n\r\v]" nil t)
(forward-char 1)
(looking-at litorgy-inline-src-block-regexp))
(litorgy-parse-inline-src-block-match)
(looking-at org-babel-inline-src-block-regexp))
(org-babel-parse-inline-src-block-match)
nil)))) ;; indicate that no source block was found
(defun litorgy-parse-src-block-match ()
(list (litorgy-clean-text-properties (match-string 1))
(litorgy-clean-text-properties (match-string 4))
(org-combine-plists litorgy-default-header-args
(litorgy-parse-header-arguments (litorgy-clean-text-properties (or (match-string 3) ""))))))
(defun org-babel-parse-src-block-match ()
(list (org-babel-clean-text-properties (match-string 1))
(org-babel-clean-text-properties (match-string 4))
(org-combine-plists org-babel-default-header-args
(org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) ""))))))
(defun litorgy-parse-inline-src-block-match ()
(list (litorgy-clean-text-properties (match-string 1))
(litorgy-clean-text-properties (match-string 4))
(org-combine-plists litorgy-default-inline-header-args
(litorgy-parse-header-arguments (litorgy-clean-text-properties (or (match-string 3) ""))))))
(defun org-babel-parse-inline-src-block-match ()
(list (org-babel-clean-text-properties (match-string 1))
(org-babel-clean-text-properties (match-string 4))
(org-combine-plists org-babel-default-inline-header-args
(org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) ""))))))
(defun litorgy-parse-header-arguments (arg-string)
(defun org-babel-parse-header-arguments (arg-string)
"Parse a string of header arguments returning an alist."
(delq nil
(mapcar
@ -192,7 +192,7 @@ of the following form. (language body header-arguments-alist)"
(cons (intern (concat ":" (match-string 1 arg))) (match-string 2 arg))))
(split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))
(defun litorgy-where-is-src-block-head ()
(defun org-babel-where-is-src-block-head ()
"Return the point at the beginning of the current source
block. Specifically at the beginning of the #+BEGIN_SRC line.
If the point is not on a source block then return nil."
@ -201,21 +201,21 @@ If the point is not on a source block then return nil."
(save-excursion ;; on a #+srcname: line
(beginning-of-line 1)
(and (looking-at "#\\+srcname") (forward-line 1)
(looking-at litorgy-src-block-regexp)
(looking-at org-babel-src-block-regexp)
(point)))
(save-excursion ;; on a #+begin_src line
(beginning-of-line 1)
(and (looking-at litorgy-src-block-regexp)
(and (looking-at org-babel-src-block-regexp)
(point)))
(save-excursion ;; inside a src block
(and
(re-search-backward "#\\+begin_src" nil t) (setq top (point))
(re-search-forward "#\\+end_src" nil t) (setq bottom (point))
(< top initial) (< initial bottom)
(goto-char top) (looking-at litorgy-src-block-regexp)
(goto-char top) (looking-at org-babel-src-block-regexp)
(point))))))
(defun litorgy-find-named-result (name)
(defun org-babel-find-named-result (name)
"Return the location of the result named NAME in the current
buffer or nil if no such result exists."
(save-excursion
@ -223,15 +223,15 @@ buffer or nil if no such result exists."
(when (re-search-forward (concat "#\\+resname:[ \t]*" (regexp-quote name)) nil t)
(move-beginning-of-line 1) (point))))
(defun litorgy-where-is-src-block-result ()
(defun org-babel-where-is-src-block-result ()
"Return the point at the beginning of the result of the current
source block. Specifically at the beginning of the #+RESNAME:
line. If no result exists for this block then create a
#+RESNAME: line following the source block."
(save-excursion
(goto-char (litorgy-where-is-src-block-head))
(let ((name (litorgy-get-src-block-name)) end head)
(or (and name (message name) (litorgy-find-named-result name))
(goto-char (org-babel-where-is-src-block-head))
(let ((name (org-babel-get-src-block-name)) end head)
(or (and name (message name) (org-babel-find-named-result name))
(and (re-search-forward "#\\+end_src" nil t)
(progn (move-end-of-line 1) (forward-char 1) (setq end (point))
(or (progn ;; either an unnamed #+resname: line already exists
@ -243,7 +243,7 @@ line. If no result exists for this block then create a
(move-beginning-of-line 1) t)))
(point))))))
(defun litorgy-insert-result (result &optional insert)
(defun org-babel-insert-result (result &optional insert)
"Insert RESULT into the current buffer after the end of the
current source block. With optional argument INSERT controls
insertion of results in the org-mode file. INSERT can take the
@ -259,10 +259,10 @@ silent -- no results are inserted"
(if insert (setq insert (split-string insert)))
(if (stringp result)
(progn
(setq result (litorgy-clean-text-properties result))
(if (member "file" insert) (setq result (litorgy-result-to-file result))))
(setq result (org-babel-clean-text-properties result))
(if (member "file" insert) (setq result (org-babel-result-to-file result))))
(unless (listp result) (setq result (format "%S" result))))
(if (and insert (member "replace" insert)) (litorgy-remove-result))
(if (and insert (member "replace" insert)) (org-babel-remove-result))
(if (= (length result) 0)
(message "no result returned by source block")
(if (and insert (member "silent" insert))
@ -272,11 +272,11 @@ silent -- no results are inserted"
(string-equal (substring result -1) "\r"))))
(setq result (concat result "\n")))
(save-excursion
(goto-char (litorgy-where-is-src-block-result)) (forward-line 1)
(goto-char (org-babel-where-is-src-block-result)) (forward-line 1)
(if (stringp result) ;; assume the result is a table if it's not a string
(if (member "file" insert)
(insert result)
(litorgy-examplize-region (point) (progn (insert result) (point))))
(org-babel-examplize-region (point) (progn (insert result) (point))))
(progn
(insert
(concat (orgtbl-to-orgtbl
@ -286,15 +286,15 @@ silent -- no results are inserted"
(org-cycle))))
(message "finished"))))
(defun litorgy-result-to-org-string (result)
(defun org-babel-result-to-org-string (result)
"Return RESULT as a string in org-mode format. This function
relies on `litorgy-insert-result'."
(with-temp-buffer (litorgy-insert-result result) (buffer-string)))
relies on `org-babel-insert-result'."
(with-temp-buffer (org-babel-insert-result result) (buffer-string)))
(defun litorgy-remove-result ()
(defun org-babel-remove-result ()
"Remove the result of the current source block."
(save-excursion
(goto-char (litorgy-where-is-src-block-result)) (forward-line 1)
(goto-char (org-babel-where-is-src-block-result)) (forward-line 1)
(delete-region (point)
(save-excursion
(if (org-at-table-p)
@ -306,14 +306,14 @@ relies on `litorgy-insert-result'."
(forward-line -1)
(point))))))
(defun litorgy-result-to-file (result)
(defun org-babel-result-to-file (result)
"Return an `org-mode' link with the path being the value or
RESULT, and the display being the `file-name-nondirectory' if
non-nil."
(let ((name (file-name-nondirectory result)))
(concat "[[" result (if name (concat "][" name "]]") "]]"))))
(defun litorgy-examplize-region (beg end)
(defun org-babel-examplize-region (beg end)
"Comment out region using the ': ' org example quote."
(interactive "*r")
(let ((size (abs (- (line-number-at-pos end)
@ -327,11 +327,11 @@ non-nil."
(dotimes (n size)
(move-beginning-of-line 1) (insert ": ") (forward-line 1))))))
(defun litorgy-clean-text-properties (text)
(defun org-babel-clean-text-properties (text)
"Strip all properties from text return."
(set-text-properties 0 (length text) nil text) text)
(defun litorgy-read (cell)
(defun org-babel-read (cell)
"Convert the string value of CELL to a number if appropriate.
Otherwise if cell looks like a list (meaning it starts with a
'(') then read it as lisp, otherwise return it unmodified as a
@ -339,7 +339,7 @@ string.
This is taken almost directly from `org-read-prop'."
(if (and (stringp cell) (not (equal cell "")))
(if (litorgy-number-p cell)
(if (org-babel-number-p cell)
(string-to-number cell)
(if (or (equal "(" (substring cell 0 1))
(equal "'" (substring cell 0 1)))
@ -347,11 +347,11 @@ This is taken almost directly from `org-read-prop'."
(progn (set-text-properties 0 (length cell) nil cell) cell)))
cell))
(defun litorgy-number-p (string)
(defun org-babel-number-p (string)
"Return t if STRING represents a number"
(string-match "^[[:digit:]]*\\.?[[:digit:]]*$" string))
(defun litorgy-chomp (string &optional regexp)
(defun org-babel-chomp (string &optional regexp)
"Remove any trailing space or carriage returns characters from
STRING. Default regexp used is \"[ \f\t\n\r\v]\" but can be
overwritten by specifying a regexp as a second argument."
@ -359,5 +359,5 @@ overwritten by specifying a regexp as a second argument."
(setq results (substring results 0 -1)))
results)
(provide 'litorgy)
;;; litorgy.el ends here
(provide 'org-babel)
;;; org-babel.el ends here