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 ;; Copyright (C) 2009 Eric Schulte
@ -26,56 +26,56 @@
;;; Commentary: ;;; Commentary:
;; Litorgy support for evaluating R code ;; Org-Babel support for evaluating R code
;;; 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 "This is the main function which wraps each R source code
block.") block.")
(defun litorgy-execute:R (body params) (defun org-babel-execute:R (body params)
"Execute a block of R code with litorgy. This function is "Execute a block of R code with org-babel. This function is
called by `litorgy-execute-src-block'." called by `org-babel-execute-src-block'."
(message "executing R source code block...") (message "executing R source code block...")
(save-window-excursion (save-window-excursion
(let ((vars (litorgy-ref-variables params)) (let ((vars (org-babel-ref-variables params))
results) results)
(litorgy-R-initiate-R-buffer) (org-babel-R-initiate-R-buffer)
(mapc (lambda (pair) (litorgy-R-assign-elisp (car pair) (cdr pair))) vars) (mapc (lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair))) vars)
(litorgy-R-input-command (org-babel-R-input-command
(format "%s <- function ()\n{\n%s\n}" litorgy-R-func-name body)) (format "%s <- function ()\n{\n%s\n}" org-babel-R-func-name body))
(litorgy-R-to-elisp litorgy-R-func-name)))) (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." "Quote field S for export to R."
(if (stringp s) (if (stringp s)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
(format "%S" 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 "Read the elisp VALUE into a variable named NAME in the current
R process in `litorgy-R-buffer'." R process in `org-babel-R-buffer'."
(unless litorgy-R-buffer (error "No active R buffer")) (unless org-babel-R-buffer (error "No active R buffer"))
(litorgy-R-input-command (org-babel-R-input-command
(if (listp value) (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) ;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value))) (unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file (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")) (insert "\n"))
(format "%s <- read.table(\"%s\", sep=\"\\t\", as.is=TRUE)" name transition-file)) (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 "Return the result of calling the function named FUNC-NAME in
`litorgy-R-buffer' as Emacs lisp." `org-babel-R-buffer' as Emacs lisp."
(let ((tmp-file (make-temp-file "litorgy-R")) result) (let ((tmp-file (make-temp-file "org-babel-R")) result)
(litorgy-R-input-command (org-babel-R-input-command
(format "write.table(%s(), \"%s\", , ,\"\\t\", ,\"nil\", , FALSE, FALSE)" func-name tmp-file)) (format "write.table(%s(), \"%s\", , ,\"\\t\", ,\"nil\", , FALSE, FALSE)" func-name tmp-file))
(with-temp-buffer (with-temp-buffer
(message "before condition") (message "before condition")
@ -84,7 +84,7 @@ R process in `litorgy-R-buffer'."
(org-table-import tmp-file nil) (org-table-import tmp-file nil)
(delete-file tmp-file) (delete-file tmp-file)
(setq result (mapcar (lambda (row) (setq result (mapcar (lambda (row)
(mapcar #'litorgy-R-read row)) (mapcar #'org-babel-R-read row))
(org-table-to-lisp)))) (org-table-to-lisp))))
(error nil)) (error nil))
(message "after condition") (message "after condition")
@ -96,58 +96,58 @@ R process in `litorgy-R-buffer'."
(car result)) (car result))
result)))) result))))
(defun litorgy-R-read (cell) (defun org-babel-R-read (cell)
"Strip nested \"s from around strings in exported R values." "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) (string-match "\\\"\\(.+\\)\\\"" cell)
(match-string 1 cell)) (match-string 1 cell))
cell))) cell)))
;; functions for evaluation of R code ;; 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") "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." "If there is not a current R process then create one."
;; DED: Ideally I think we should use ESS mechanisms for this sort ;; DED: Ideally I think we should use ESS mechanisms for this sort
;; of thing. See ess-force-buffer-current. ;; 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 (save-excursion
(R) (R)
(setf litorgy-R-buffer (current-buffer)) (setf org-babel-R-buffer (current-buffer))
(litorgy-R-wait-for-output) (org-babel-R-wait-for-output)
(litorgy-R-input-command "")))) (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." "Send a command to R, and return the results as a string."
(litorgy-R-input-command command) (org-babel-R-input-command command)
(litorgy-R-last-output)) (org-babel-R-last-output))
(defun litorgy-R-input-command (command) (defun org-babel-R-input-command (command)
"Pass COMMAND to the R process running in `litorgy-R-buffer'." "Pass COMMAND to the R process running in `org-babel-R-buffer'."
(save-excursion (save-excursion
(save-match-data (save-match-data
(set-buffer litorgy-R-buffer) (set-buffer org-babel-R-buffer)
(goto-char (process-mark (get-buffer-process (current-buffer)))) (goto-char (process-mark (get-buffer-process (current-buffer))))
(insert command) (insert command)
(comint-send-input) (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" "Wait until output arrives"
(save-excursion (save-excursion
(save-match-data (save-match-data
(set-buffer litorgy-R-buffer) (set-buffer org-babel-R-buffer)
(while (progn (while (progn
(goto-char comint-last-input-end) (goto-char comint-last-input-end)
(not (re-search-forward comint-prompt-regexp nil t))) (not (re-search-forward comint-prompt-regexp nil t)))
(accept-process-output (get-buffer-process (current-buffer))))))) (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" "Return the last R output as a string"
(save-excursion (save-excursion
(save-match-data (save-match-data
(set-buffer litorgy-R-buffer) (set-buffer org-babel-R-buffer)
(goto-char (process-mark (get-buffer-process (current-buffer)))) (goto-char (process-mark (get-buffer-process (current-buffer))))
(forward-line 0) (forward-line 0)
(let ((raw (buffer-substring comint-last-input-end (- (point) 1))) (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 ;; drop first, because it's the last line of input
(cdr (split-string raw "[\n\r]")))) "\n"))))) (cdr (split-string raw "[\n\r]")))) "\n")))))
(provide 'litorgy-R) (provide 'org-babel-R)
;;; litorgy-R.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte
@ -26,15 +26,15 @@
;;; Commentary: ;;; Commentary:
;; for more information see the comments in litorgy.el ;; for more information see the comments in org-babel.el
;;; Code: ;;; Code:
(require 'litorgy) (require 'org-babel)
(require 'org-exp-blocks) (require 'org-exp-blocks)
(add-to-list 'org-export-blocks '(src litorgy-exp-src-blocks)) (add-to-list 'org-export-blocks '(src org-babel-exp-src-blocks))
(add-to-list 'org-export-interblocks '(src litorgy-exp-inline-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' "Process src block for export. Depending on the 'export'
headers argument in replace the source code block with... 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" none ----- do not display either code or results upon export"
(interactive) (interactive)
(unless headers (error "litorgy can't process a source block without knowing the source code")) (unless headers (error "org-babel can't process a source block without knowing the source code"))
(message "litorgy processing...") (message "org-babel processing...")
(let ((lang (car headers)) (let ((lang (car headers))
(params (litorgy-parse-header-arguments (mapconcat #'identity (cdr headers) " ")))) (params (org-babel-parse-header-arguments (mapconcat #'identity (cdr headers) " "))))
(litorgy-exp-do-export lang body params))) (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. "Process inline src blocks between START and END for export.
See `litorgy-exp-src-blocks' for export options, currently the See `org-babel-exp-src-blocks' for export options, currently the
options and are taken from `litorgy-defualt-inline-header-args'." options and are taken from `org-babel-defualt-inline-header-args'."
(interactive) (interactive)
(save-excursion (save-excursion
(goto-char start) (goto-char start)
(while (and (< (point) end) (re-search-forward litorgy-inline-src-block-regexp end t)) (while (and (< (point) end) (re-search-forward org-babel-inline-src-block-regexp end t))
(let* ((info (save-match-data (litorgy-parse-inline-src-block-match))) (let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
(replacement (save-match-data (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) (setf end (+ end (- (length replacement)
(+ 6 (length (first info)) (length (second info)))))) (+ 6 (length (first info)) (length (second info))))))
(replace-match replacement t t))))) (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")) (case (intern (or (cdr (assoc :exports params)) "code"))
('none "") ('none "")
('code (litorgy-exp-code body lang params inline)) ('code (org-babel-exp-code body lang params inline))
('results (litorgy-exp-results body lang params inline)) ('results (org-babel-exp-results body lang params inline))
('both (concat (litorgy-exp-code body lang params inline) ('both (concat (org-babel-exp-code body lang params inline)
"\n\n" "\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 (if inline
(format "=%s=" body) (format "=%s=" body)
(format "#+BEGIN_SRC %s\n%s%s\n#+END_SRC" lang body (format "#+BEGIN_SRC %s\n%s%s\n#+END_SRC" lang body
(if (string-match "\n$" body) "" "\n")))) (if (string-match "\n$" body) "" "\n"))))
(defun litorgy-exp-results (body lang params &optional inline) (defun org-babel-exp-results (body lang params &optional inline)
(let* ((cmd (intern (concat "litorgy-execute:" lang))) (let* ((cmd (intern (concat "org-babel-execute:" lang)))
(result (funcall cmd body params)) (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 (if inline
(format "=%s=" result) (format "=%s=" result)
(if (stringp result) (if (stringp result)
@ -94,5 +94,5 @@ options and are taken from `litorgy-defualt-inline-header-args'."
(if (string-match "\n$" body) "" "\n")) (if (string-match "\n$" body) "" "\n"))
result-as-org)))) result-as-org))))
(provide 'litorgy-exp) (provide 'org-babel-exp)
;;; litorgy-exp.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte
@ -26,23 +26,23 @@
;;; Commentary: ;;; Commentary:
;; for more information see the comments in litorgy.el ;; for more information see the comments in org-babel.el
;;; Code: ;;; Code:
(require 'org) (require 'org)
(require 'org-exp-blocks) (require 'org-exp-blocks)
(load "htmlize.el") ;; other versions of htmlize can cause export problems (load "htmlize.el") ;; other versions of htmlize can cause export problems
(require 'litorgy) (require 'org-babel)
(require 'litorgy-ref) (require 'org-babel-ref)
(require 'litorgy-ui) (require 'org-babel-ui)
(require 'litorgy-exp) (require 'org-babel-exp)
(require 'litorgy-table) (require 'org-babel-table)
;; language specific files ;; language specific files
(require 'litorgy-script) (require 'org-babel-script)
(require 'litorgy-shell) (require 'org-babel-shell)
(require 'litorgy-lisp) (require 'org-babel-lisp)
(require 'litorgy-R) (require 'org-babel-R)
(provide 'litorgy-init) (provide 'org-babel-init)
;;; litorgy-init.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte
@ -26,24 +26,24 @@
;;; Commentary: ;;; Commentary:
;; Litorgy support for evaluating lisp code ;; Org-Babel support for evaluating lisp code
;;; 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) (defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with litorgy. This "Execute a block of emacs-lisp code with org-babel. This
function is called by `litorgy-execute-src-block'." function is called by `org-babel-execute-src-block'."
(message "executing emacs-lisp code block...") (message "executing emacs-lisp code block...")
(save-window-excursion (save-window-excursion
(let ((vars (litorgy-ref-variables params)) (let ((vars (org-babel-ref-variables params))
(print-level nil) (print-length nil) results) (print-level nil) (print-length nil) results)
(setq results (setq results
(eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) vars) (eval `(let ,(mapcar (lambda (var) `(,(car var) ',(cdr var))) vars)
,(read (concat "(progn " body ")"))))) ,(read (concat "(progn " body ")")))))
results))) results)))
(provide 'litorgy-lisp) (provide 'org-babel-lisp)
;;; litorgy-lisp.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
@ -27,7 +27,7 @@
;;; Commentary: ;;; Commentary:
;; Functions for referencing data from the header arguments of a ;; 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 ;; #+VAR: variable-name=file:resource-id
;; ;;
@ -44,7 +44,7 @@
;; ;;
;; #+TBLNAME: sandbox ;; #+TBLNAME: sandbox
;; | 1 | 2 | 3 | ;; | 1 | 2 | 3 |
;; | 4 | litorgy | 6 | ;; | 4 | org-babel | 6 |
;; ;;
;; #+begin_src emacs-lisp :var table=sandbox ;; #+begin_src emacs-lisp :var table=sandbox
;; (message table) ;; (message table)
@ -52,19 +52,19 @@
;; ;;
;;; Code: ;;; 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 "Takes a parameter alist, and return an alist of variable
names, and the emacs-lisp representation of the related value." 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)))) (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 "Parse a variable ASSIGNMENT in a header argument. If the
right hand side of the assignment has a literal value return that right hand side of the assignment has a literal value return that
value, otherwise interpret as a reference to an external resource 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 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 will be the name of the variable, and the second will be an
emacs-lisp representation of the value of the variable." 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)) (let ((var (match-string 1 assignment))
(ref (match-string 2 assignment))) (ref (match-string 2 assignment)))
(cons (intern var) (cons (intern var)
(or (litorgy-ref-literal ref) (or (org-babel-ref-literal ref)
(litorgy-ref-resolve-reference 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 "Determine if the right side of a header argument variable
assignment is a literal value or is a reference to some external assignment is a literal value or is a reference to some external
resource. If REF is literal then return it's value, otherwise resource. If REF is literal then return it's value, otherwise
return nil." return nil."
(let ((out (litorgy-read ref))) (let ((out (org-babel-read ref)))
(if (equal out ref) (if (equal out ref)
(if (string-match "\"\\(.+\\)\"" ref) (if (string-match "\"\\(.+\\)\"" ref)
(read ref)) (read ref))
out))) out)))
(defun litorgy-ref-resolve-reference (ref) (defun org-babel-ref-resolve-reference (ref)
"Resolve the reference and return it's value" "Resolve the reference and return it's value"
(save-excursion (save-excursion
(let ((case-fold-search t) (let ((case-fold-search t)
@ -120,7 +120,7 @@ return nil."
;; (move-marker id-loc nil) ;; (move-marker id-loc nil)
(progn (message (format "reference '%s' not found in this buffer" ref)) (progn (message (format "reference '%s' not found in this buffer" ref))
(error (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) (forward-line 1)
(beginning-of-line) (beginning-of-line)
(if (or (= (point) (point-min)) (= (point) (point-max))) (if (or (= (point) (point-min)) (= (point) (point-max)))
@ -128,18 +128,18 @@ return nil."
(case type (case type
('table ('table
(mapcar (lambda (row) (mapcar (lambda (row)
(mapcar #'litorgy-read row)) (mapcar #'org-babel-read row))
(org-table-to-lisp))) (org-table-to-lisp)))
('source-block ('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)))))) (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 "Return the type of reference located at point or nil of none
of the supported reference types are found. Supported reference of the supported reference types are found. Supported reference
types are tables and source blocks." types are tables and source blocks."
(cond ((org-at-table-p) 'table) (cond ((org-at-table-p) 'table)
((looking-at "^#\\+BEGIN_SRC") 'source-block))) ((looking-at "^#\\+BEGIN_SRC") 'source-block)))
(provide 'litorgy-ref) (provide 'org-babel-ref)
;;; litorgy-ref.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte
@ -26,24 +26,24 @@
;;; Commentary: ;;; Commentary:
;; Litorgy support for evaluating ruby, and python source code. ;; Org-Babel support for evaluating ruby, and python source code.
;;; 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) (set-default var cmds)
(mapc (lambda (cmd) (mapc (lambda (cmd)
(setq litorgy-interpreters (cons cmd litorgy-interpreters)) (setq org-babel-interpreters (cons cmd org-babel-interpreters))
(eval (eval
`(defun ,(intern (concat "litorgy-execute:" cmd)) (body params) `(defun ,(intern (concat "org-babel-execute:" cmd)) (body params)
,(concat "Evaluate a block of " cmd " script with litorgy. This function is ,(concat "Evaluate a block of " cmd " script with org-babel. This function is
called by `litorgy-execute-src-block'. This function is an called by `org-babel-execute-src-block'. This function is an
automatically generated wrapper for `litorgy-script-execute'.") automatically generated wrapper for `org-babel-script-execute'.")
(litorgy-script-execute ,cmd body params)))) (org-babel-script-execute ,cmd body params))))
cmds)) cmds))
(defvar litorgy-script-ruby-wrapper-method (defvar org-babel-script-ruby-wrapper-method
" "
def main def main
%s %s
@ -52,36 +52,36 @@ results = main()
puts (results.class == String) ? results : results.inspect puts (results.class == String) ? results : results.inspect
") ")
(defvar litorgy-script-python-wrapper-method (defvar org-babel-script-python-wrapper-method
" "
def main(): def main():
%s %s
print main()") print main()")
(defcustom litorgy-script-interpreters '("ruby" "python") (defcustom org-babel-script-interpreters '("ruby" "python")
"List of interpreters of scripting languages which can be "List of interpreters of scripting languages which can be
executed through litorgy." executed through org-babel."
:group 'litorgy :group 'org-babel
:set 'litorgy-script-add-interpreter) :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." "Run CMD on BODY obeying any options set with PARAMS."
(message (format "executing %s code block..." cmd)) (message (format "executing %s code block..." cmd))
(let ((vars (litorgy-ref-variables params))) (let ((vars (org-babel-ref-variables params)))
(save-window-excursion (save-window-excursion
(with-temp-buffer (with-temp-buffer
(insert (insert
(format (format
(case (intern cmd) (case (intern cmd)
('ruby litorgy-script-ruby-wrapper-method) ('ruby org-babel-script-ruby-wrapper-method)
('python litorgy-script-python-wrapper-method)) ('python org-babel-script-python-wrapper-method))
(concat (concat
(mapconcat ;; define any variables (mapconcat ;; define any variables
(lambda (pair) (lambda (pair)
(format "\t%s=%s" (format "\t%s=%s"
(car pair) (car pair)
(litorgy-script-var-to-ruby/python (cdr pair)))) (org-babel-script-var-to-ruby/python (cdr pair))))
vars "\n") vars "\n")
"\n" "\n"
(let ((body-lines (split-string body "[\n\r]+" t))) (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 ;; (message (buffer-substring (point-min) (point-max))) ;; debug script
(shell-command-on-region (point-min) (point-max) cmd nil 'replace) (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
;; (message (format "shell output = %s" (buffer-string))) ;; debug results ;; (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 "Convert an elisp var into a string of ruby or python source
code specifying a var of the same value." code specifying a var of the same value."
(if (listp var) (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))) (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 "If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string." Emacs-lisp table, otherwise return the results as a string."
(setq results (litorgy-chomp results)) (setq results (org-babel-chomp results))
(litorgy-read (org-babel-read
(if (string-match "^\\[.+\\]$" results) (if (string-match "^\\[.+\\]$" results)
;; somewhat hacky, but thanks to similarities between languages ;; somewhat hacky, but thanks to similarities between languages
;; it seems to work ;; 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
"\\]" ")" (replace-regexp-in-string "\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string ", " " " (replace-regexp-in-string
"'" "\"" results))))) "'" "\"" results)))))
(litorgy-chomp results)))) (org-babel-chomp results))))
(provide 'litorgy-script) (provide 'org-babel-script)
;;; litorgy-script.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte
@ -26,50 +26,50 @@
;;; Commentary: ;;; Commentary:
;; Litorgy support for evaluating sh, bash, and zsh shells ;; Org-Babel support for evaluating sh, bash, and zsh shells
;;; Code: ;;; 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) (set-default var cmds)
(mapc (lambda (cmd) (mapc (lambda (cmd)
(setq litorgy-interpreters (cons cmd litorgy-interpreters)) (setq org-babel-interpreters (cons cmd org-babel-interpreters))
(eval (eval
`(defun ,(intern (concat "litorgy-execute:" cmd)) (body params) `(defun ,(intern (concat "org-babel-execute:" cmd)) (body params)
,(concat "Evaluate a block of " cmd " shell with litorgy. This function is ,(concat "Evaluate a block of " cmd " shell with org-babel. This function is
called by `litorgy-execute-src-block'. This function is an called by `org-babel-execute-src-block'. This function is an
automatically generated wrapper for `litorgy-shell-execute'.") automatically generated wrapper for `org-babel-shell-execute'.")
(litorgy-shell-execute ,cmd body params)))) (org-babel-shell-execute ,cmd body params))))
cmds)) 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 "List of interpreters of shelling languages which can be
executed through litorgy." executed through org-babel."
:group 'litorgy :group 'org-babel
:set 'litorgy-shell-add-interpreter) :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." "Run CMD on BODY obeying any options set with PARAMS."
(message (format "executing %s code block..." cmd)) (message (format "executing %s code block..." cmd))
(let ((vars (litorgy-ref-variables params))) (let ((vars (org-babel-ref-variables params)))
(save-window-excursion (save-window-excursion
(with-temp-buffer (with-temp-buffer
(if (> (length vars) 0) (if (> (length vars) 0)
(error "currently no support for passing variables to shells")) (error "currently no support for passing variables to shells"))
(insert body) (insert body)
(shell-command-on-region (point-min) (point-max) cmd nil 'replace) (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) (defun org-babel-shell-to-elisp (result)
(let ((tmp-file (make-temp-file "litorgy-shell"))) (let ((tmp-file (make-temp-file "org-babel-shell")))
(with-temp-file tmp-file (with-temp-file tmp-file
(insert result)) (insert result))
(with-temp-buffer (with-temp-buffer
(org-table-import tmp-file nil) (org-table-import tmp-file nil)
(delete-file tmp-file) (delete-file tmp-file)
(setq result (mapcar (lambda (row) (setq result (mapcar (lambda (row)
(mapcar #'litorgy-read row)) (mapcar #'org-babel-read row))
(org-table-to-lisp))) (org-table-to-lisp)))
(if (null (cdr result)) ;; if result is trivial vector, then scalarize it (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
(if (consp (car result)) (if (consp (car result))
@ -79,5 +79,5 @@ executed through litorgy."
(car result)) (car result))
result)))) result))))
(provide 'litorgy-shell) (provide 'org-babel-shell)
;;; litorgy-shell.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte
@ -53,9 +53,9 @@
;; #+TBLFM: $2='(sbe 'fibbd (n $1)) ;; #+TBLFM: $2='(sbe 'fibbd (n $1))
;;; Code: ;;; 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)) (if (and (stringp string) (string-match "[\n\r]" string))
(concat (substring string 0 (match-beginning 0)) "...") (concat (substring string 0 (match-beginning 0)) "...")
string)) string))
@ -74,9 +74,9 @@ source code block.
results results
#+end_src" #+end_src"
(unless (stringp source-block) (setq source-block (symbol-name source-block))) (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)) (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=" (concat ":var results="
,source-block ,source-block
"(" "("
@ -84,8 +84,8 @@ results
(format "%S=%s" (first var-spec) (second var-spec))) (format "%S=%s" (first var-spec) (second var-spec)))
',variables ", ") ',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) (provide 'org-babel-table)
;;; litorgy-table.el ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
@ -26,44 +26,44 @@
;;; Commentary: ;;; Commentary:
;; UI elements of litorgy ;; UI elements of org-babel
;; - code folding ;; - code folding
;; - marking working code blocks ;; - marking working code blocks
;;; Code: ;;; Code:
(require 'litorgy) (require 'org-babel)
(defun litorgy-ui-src-block-cycle-maybe () (defun org-babel-ui-src-block-cycle-maybe ()
"Detect if this is context for a litorgical src-block and if so "Detect if this is context for a org-babel src-block and if so
then run `litorgy-execute-src-block'." then run `org-babel-execute-src-block'."
(let ((case-fold-search t)) (let ((case-fold-search t))
(if (save-excursion (if (save-excursion
(beginning-of-line 1) (beginning-of-line 1)
(looking-at litorgy-src-block-regexp)) (looking-at org-babel-src-block-regexp))
(progn (call-interactively 'litorgy-ui-src-block-cycle) (progn (call-interactively 'org-babel-ui-src-block-cycle)
t) ;; to signal that we took action t) ;; to signal that we took action
nil))) ;; to signal that we did not 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" "Cycle the visibility of the current source code block"
(interactive) (interactive)
;; should really do this once in an (org-mode hook) ;; 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") (message "trying out source block")
(save-excursion (save-excursion
(beginning-of-line) (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 (let ((start (- (match-beginning 4) 1)) ;; beginning of body
(end (match-end 0))) ;; end of entire body (end (match-end 0))) ;; end of entire body
(if (memq t (mapcar (lambda (overlay) (if (memq t (mapcar (lambda (overlay)
(eq (overlay-get overlay 'invisible) 'litorgy-ui)) (eq (overlay-get overlay 'invisible) 'org-babel-ui))
(overlays-at start))) (overlays-at start)))
(remove-overlays start end 'invisible 'litorgy-ui) (remove-overlays start end 'invisible 'org-babel-ui)
(overlay-put (make-overlay start end) 'invisible 'litorgy-ui))) (overlay-put (make-overlay start end) 'invisible 'org-babel-ui)))
(error "not looking at a source block")))) (error "not looking at a source block"))))
;; org-tab-after-check-for-cycling-hook ;; 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) (provide 'org-babel-ui)
;;; litorgy-ui ends here ;;; 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 ;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
@ -31,50 +31,50 @@
;;; Code: ;;; Code:
(require 'org) (require 'org)
(defun litorgy-execute-src-block-maybe () (defun org-babel-execute-src-block-maybe ()
"Detect if this is context for a litorgical src-block and if so "Detect if this is context for a org-babel src-block and if so
then run `litorgy-execute-src-block'." then run `org-babel-execute-src-block'."
(interactive) (interactive)
(let ((info (litorgy-get-src-block-info))) (let ((info (org-babel-get-src-block-info)))
(if info (progn (litorgy-execute-src-block current-prefix-arg info) t) nil))) (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.") "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.") "Default arguments to use when evaluating an inline source block.")
(defvar litorgy-src-block-regexp nil (defvar org-babel-src-block-regexp nil
"Regexp used to test when inside of a litorgical src-block") "Regexp used to test when inside of a org-babel src-block")
(defvar litorgy-inline-src-block-regexp nil (defvar org-babel-inline-src-block-regexp nil
"Regexp used to test when on an inline litorgical src-block") "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) (set-default var value)
(setq litorgy-src-block-regexp (setq org-babel-src-block-regexp
(concat "#\\+begin_src \\(" (concat "#\\+begin_src \\("
(mapconcat 'regexp-quote value "\\|") (mapconcat 'regexp-quote value "\\|")
"\\)[ \t]*" "\\)[ \t]*"
"\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments "\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments
"\\([^\000]+?\\)#\\+end_src")) "\\([^\000]+?\\)#\\+end_src"))
(setq litorgy-inline-src-block-regexp (setq org-babel-inline-src-block-regexp
(concat "src_\\(" (concat "src_\\("
(mapconcat 'regexp-quote value "\\|") (mapconcat 'regexp-quote value "\\|")
"\\)" "\\)"
"\\(\\|\\[\\(.*\\)\\]\\)" "\\(\\|\\[\\(.*\\)\\]\\)"
"{\\([^\n]+\\)}"))) "{\\([^\n]+\\)}")))
(defun litorgy-add-interpreter (interpreter) (defun org-babel-add-interpreter (interpreter)
"Add INTERPRETER to `litorgy-interpreters' and update "Add INTERPRETER to `org-babel-interpreters' and update
`litorgy-src-block-regexp' appropriately." `org-babel-src-block-regexp' appropriately."
(unless (member interpreter litorgy-interpreters) (unless (member interpreter org-babel-interpreters)
(setq litorgy-interpreters (cons interpreter litorgy-interpreters)) (setq org-babel-interpreters (cons interpreter org-babel-interpreters))
(litorgy-set-interpreters 'litorgy-interpreters litorgy-interpreters))) (org-babel-set-interpreters 'org-babel-interpreters org-babel-interpreters)))
(defcustom litorgy-interpreters '() (defcustom org-babel-interpreters '()
"Interpreters allows for evaluation tags. "Interpreters allows for evaluation tags.
This is a list of program names (as strings) that can evaluate code and 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 insert the output into an Org-mode buffer. Valid choices are
@ -86,12 +86,12 @@ perl The perl interpreter
python The python interpreter python The python interpreter
ruby The ruby 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 when a new interpreter is added to this list through the
customize interface. To add interpreters to this variable from customize interface. To add interpreters to this variable from
lisp code use the `litorgy-add-interpreter' function." lisp code use the `org-babel-add-interpreter' function."
:group 'litorgy :group 'org-babel
:set 'litorgy-set-interpreters :set 'org-babel-set-interpreters
:type '(set :greedy t :type '(set :greedy t
(const "R") (const "R")
(const "emacs-lisp") (const "emacs-lisp")
@ -101,7 +101,7 @@ lisp code use the `litorgy-add-interpreter' function."
(const "ruby"))) (const "ruby")))
;;; functions ;;; 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 "Execute the current source code block, and dump the results
into the buffer immediately following the block. Results are into the buffer immediately following the block. Results are
commented by `org-toggle-fixed-width-section'. With optional 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). source block).
Optionally supply a value for INFO in the form returned by 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 Optionally supply a value for PARAMS which will be merged with
the header arguments specified at the source code block." the header arguments specified at the source code block."
(interactive) (interactive)
(let* ((info (or info (litorgy-get-src-block-info))) (let* ((info (or info (org-babel-get-src-block-info)))
(lang (first info)) (lang (first info))
(body (second info)) (body (second info))
(params (org-combine-plists (third info) params)) (params (org-combine-plists (third info) params))
(cmd (intern (concat "litorgy-execute:" lang))) (cmd (intern (concat "org-babel-execute:" lang)))
result) result)
;; (message (format "params=%S" params)) ;; debugging statement ;; (message (format "params=%S" params)) ;; debugging statement
(unless (member lang litorgy-interpreters) (unless (member lang org-babel-interpreters)
(error "Language is not in `litorgy-interpreters': %s" lang)) (error "Language is not in `org-babel-interpreters': %s" lang))
(setq result (funcall cmd body params)) (setq result (funcall cmd body params))
;; possibly force result into a vector ;; possibly force result into a vector
(if (and (not (listp result)) (cdr (assoc :results params)) (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))) (setq result (list result)))
(if arg (if arg
(message (format "%S" result)) (message (format "%S" result))
(litorgy-insert-result result (cdr (assoc :results params)))) (org-babel-insert-result result (cdr (assoc :results params))))
result)) result))
(defun litorgy-eval-buffer (&optional arg) (defun org-babel-eval-buffer (&optional arg)
"Replace EVAL snippets in the entire buffer." "Replace EVAL snippets in the entire buffer."
(interactive "P") (interactive "P")
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward litorgy-regexp nil t) (while (re-search-forward org-babel-regexp nil t)
(litorgy-eval-src-block arg)))) (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." "Replace EVAL snippets in the entire subtree."
(interactive "P") (interactive "P")
(save-excursion (save-excursion
(org-narrow-to-subtree) (org-narrow-to-subtree)
(litorgy-eval-buffer) (org-babel-eval-buffer)
(widen))) (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" "Return the name of the current source block if one exists"
(let ((case-fold-search t)) (let ((case-fold-search t))
(save-excursion (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) (if (save-excursion (forward-line -1)
(looking-at "#\\+srcname:[ \f\t\n\r\v]*\\([^ \f\t\n\r\v]+\\)")) (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 "Return the information of the current source block as a list
of the following form. (language body header-arguments-alist)" of the following form. (language body header-arguments-alist)"
(let ((case-fold-search t) head) (let ((case-fold-search t) head)
(if (setq head (litorgy-where-is-src-block-head)) (if (setq head (org-babel-where-is-src-block-head))
(save-excursion (goto-char head) (litorgy-parse-src-block-match)) (save-excursion (goto-char head) (org-babel-parse-src-block-match))
(if (save-excursion ;; inline source block (if (save-excursion ;; inline source block
(re-search-backward "[ \f\t\n\r\v]" nil t) (re-search-backward "[ \f\t\n\r\v]" nil t)
(forward-char 1) (forward-char 1)
(looking-at litorgy-inline-src-block-regexp)) (looking-at org-babel-inline-src-block-regexp))
(litorgy-parse-inline-src-block-match) (org-babel-parse-inline-src-block-match)
nil)))) ;; indicate that no source block was found nil)))) ;; indicate that no source block was found
(defun litorgy-parse-src-block-match () (defun org-babel-parse-src-block-match ()
(list (litorgy-clean-text-properties (match-string 1)) (list (org-babel-clean-text-properties (match-string 1))
(litorgy-clean-text-properties (match-string 4)) (org-babel-clean-text-properties (match-string 4))
(org-combine-plists litorgy-default-header-args (org-combine-plists org-babel-default-header-args
(litorgy-parse-header-arguments (litorgy-clean-text-properties (or (match-string 3) "")))))) (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) ""))))))
(defun litorgy-parse-inline-src-block-match () (defun org-babel-parse-inline-src-block-match ()
(list (litorgy-clean-text-properties (match-string 1)) (list (org-babel-clean-text-properties (match-string 1))
(litorgy-clean-text-properties (match-string 4)) (org-babel-clean-text-properties (match-string 4))
(org-combine-plists litorgy-default-inline-header-args (org-combine-plists org-babel-default-inline-header-args
(litorgy-parse-header-arguments (litorgy-clean-text-properties (or (match-string 3) "")))))) (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." "Parse a string of header arguments returning an alist."
(delq nil (delq nil
(mapcar (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)))) (cons (intern (concat ":" (match-string 1 arg))) (match-string 2 arg))))
(split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t)))) (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 "Return the point at the beginning of the current source
block. Specifically at the beginning of the #+BEGIN_SRC line. block. Specifically at the beginning of the #+BEGIN_SRC line.
If the point is not on a source block then return nil." 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 (save-excursion ;; on a #+srcname: line
(beginning-of-line 1) (beginning-of-line 1)
(and (looking-at "#\\+srcname") (forward-line 1) (and (looking-at "#\\+srcname") (forward-line 1)
(looking-at litorgy-src-block-regexp) (looking-at org-babel-src-block-regexp)
(point))) (point)))
(save-excursion ;; on a #+begin_src line (save-excursion ;; on a #+begin_src line
(beginning-of-line 1) (beginning-of-line 1)
(and (looking-at litorgy-src-block-regexp) (and (looking-at org-babel-src-block-regexp)
(point))) (point)))
(save-excursion ;; inside a src block (save-excursion ;; inside a src block
(and (and
(re-search-backward "#\\+begin_src" nil t) (setq top (point)) (re-search-backward "#\\+begin_src" nil t) (setq top (point))
(re-search-forward "#\\+end_src" nil t) (setq bottom (point)) (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
(< top initial) (< initial bottom) (< top initial) (< initial bottom)
(goto-char top) (looking-at litorgy-src-block-regexp) (goto-char top) (looking-at org-babel-src-block-regexp)
(point)))))) (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 "Return the location of the result named NAME in the current
buffer or nil if no such result exists." buffer or nil if no such result exists."
(save-excursion (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) (when (re-search-forward (concat "#\\+resname:[ \t]*" (regexp-quote name)) nil t)
(move-beginning-of-line 1) (point)))) (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 "Return the point at the beginning of the result of the current
source block. Specifically at the beginning of the #+RESNAME: source block. Specifically at the beginning of the #+RESNAME:
line. If no result exists for this block then create a line. If no result exists for this block then create a
#+RESNAME: line following the source block." #+RESNAME: line following the source block."
(save-excursion (save-excursion
(goto-char (litorgy-where-is-src-block-head)) (goto-char (org-babel-where-is-src-block-head))
(let ((name (litorgy-get-src-block-name)) end head) (let ((name (org-babel-get-src-block-name)) end head)
(or (and name (message name) (litorgy-find-named-result name)) (or (and name (message name) (org-babel-find-named-result name))
(and (re-search-forward "#\\+end_src" nil t) (and (re-search-forward "#\\+end_src" nil t)
(progn (move-end-of-line 1) (forward-char 1) (setq end (point)) (progn (move-end-of-line 1) (forward-char 1) (setq end (point))
(or (progn ;; either an unnamed #+resname: line already exists (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))) (move-beginning-of-line 1) t)))
(point)))))) (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 "Insert RESULT into the current buffer after the end of the
current source block. With optional argument INSERT controls current source block. With optional argument INSERT controls
insertion of results in the org-mode file. INSERT can take the 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 insert (setq insert (split-string insert)))
(if (stringp result) (if (stringp result)
(progn (progn
(setq result (litorgy-clean-text-properties result)) (setq result (org-babel-clean-text-properties result))
(if (member "file" insert) (setq result (litorgy-result-to-file result)))) (if (member "file" insert) (setq result (org-babel-result-to-file result))))
(unless (listp result) (setq result (format "%S" 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) (if (= (length result) 0)
(message "no result returned by source block") (message "no result returned by source block")
(if (and insert (member "silent" insert)) (if (and insert (member "silent" insert))
@ -272,11 +272,11 @@ silent -- no results are inserted"
(string-equal (substring result -1) "\r")))) (string-equal (substring result -1) "\r"))))
(setq result (concat result "\n"))) (setq result (concat result "\n")))
(save-excursion (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 (stringp result) ;; assume the result is a table if it's not a string
(if (member "file" insert) (if (member "file" insert)
(insert result) (insert result)
(litorgy-examplize-region (point) (progn (insert result) (point)))) (org-babel-examplize-region (point) (progn (insert result) (point))))
(progn (progn
(insert (insert
(concat (orgtbl-to-orgtbl (concat (orgtbl-to-orgtbl
@ -286,15 +286,15 @@ silent -- no results are inserted"
(org-cycle)))) (org-cycle))))
(message "finished")))) (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 "Return RESULT as a string in org-mode format. This function
relies on `litorgy-insert-result'." relies on `org-babel-insert-result'."
(with-temp-buffer (litorgy-insert-result result) (buffer-string))) (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." "Remove the result of the current source block."
(save-excursion (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) (delete-region (point)
(save-excursion (save-excursion
(if (org-at-table-p) (if (org-at-table-p)
@ -306,14 +306,14 @@ relies on `litorgy-insert-result'."
(forward-line -1) (forward-line -1)
(point)))))) (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 "Return an `org-mode' link with the path being the value or
RESULT, and the display being the `file-name-nondirectory' if RESULT, and the display being the `file-name-nondirectory' if
non-nil." non-nil."
(let ((name (file-name-nondirectory result))) (let ((name (file-name-nondirectory result)))
(concat "[[" result (if name (concat "][" name "]]") "]]")))) (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." "Comment out region using the ': ' org example quote."
(interactive "*r") (interactive "*r")
(let ((size (abs (- (line-number-at-pos end) (let ((size (abs (- (line-number-at-pos end)
@ -327,11 +327,11 @@ non-nil."
(dotimes (n size) (dotimes (n size)
(move-beginning-of-line 1) (insert ": ") (forward-line 1)))))) (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." "Strip all properties from text return."
(set-text-properties 0 (length text) nil text) text) (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. "Convert the string value of CELL to a number if appropriate.
Otherwise if cell looks like a list (meaning it starts with a Otherwise if cell looks like a list (meaning it starts with a
'(') then read it as lisp, otherwise return it unmodified as 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'." This is taken almost directly from `org-read-prop'."
(if (and (stringp cell) (not (equal cell ""))) (if (and (stringp cell) (not (equal cell "")))
(if (litorgy-number-p cell) (if (org-babel-number-p cell)
(string-to-number cell) (string-to-number cell)
(if (or (equal "(" (substring cell 0 1)) (if (or (equal "(" (substring cell 0 1))
(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))) (progn (set-text-properties 0 (length cell) nil cell) cell)))
cell)) cell))
(defun litorgy-number-p (string) (defun org-babel-number-p (string)
"Return t if STRING represents a number" "Return t if STRING represents a number"
(string-match "^[[:digit:]]*\\.?[[:digit:]]*$" string)) (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 "Remove any trailing space or carriage returns characters from
STRING. Default regexp used is \"[ \f\t\n\r\v]\" but can be STRING. Default regexp used is \"[ \f\t\n\r\v]\" but can be
overwritten by specifying a regexp as a second argument." 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))) (setq results (substring results 0 -1)))
results) results)
(provide 'litorgy) (provide 'org-babel)
;;; litorgy.el ends here ;;; org-babel.el ends here