mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-12-02 08:22:16 +00:00
rename litorgy to org-babel
This commit is contained in:
Eric Schulte
commit
2b9b2ee7a3
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user