diff options
author | Carsten Dominik <carsten.dominik@gmail.com> | 2008-11-20 07:50:03 +0100 |
---|---|---|
committer | Carsten Dominik <carsten.dominik@gmail.com> | 2008-11-20 07:50:03 +0100 |
commit | 8d92d2f08d22ee40f3f279311b7e27eb207c19bf (patch) | |
tree | 608f1ad898f9b727d17b88d93cfa997bc9dfb7ad | |
parent | 019bda77009f7b14dada5d04eff3f5f1f524e0f9 (diff) | |
download | org-mode-8d92d2f08d22ee40f3f279311b7e27eb207c19bf.tar.gz |
Add org-eval-light.el and org-exp-blocks.el by Eric Schulte.
-rw-r--r-- | contrib/lisp/org-eval-light.el | 200 | ||||
-rw-r--r-- | contrib/lisp/org-exp-blocks.el | 378 |
2 files changed, 578 insertions, 0 deletions
diff --git a/contrib/lisp/org-eval-light.el b/contrib/lisp/org-eval-light.el new file mode 100644 index 0000000..8e61459 --- /dev/null +++ b/contrib/lisp/org-eval-light.el @@ -0,0 +1,200 @@ +;;; org-eval-light.el --- Display result of evaluating code in various languages (light) + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org>, +;; Eric Schulte <schulte dot eric at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp, literate programming, +;; reproducible research +;; Homepage: http://orgmode.org +;; Version: 0.04 + +;; This file is not yet part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file is based off of org-eval, with the following changes. +;; +;; 1) forms are only executed manually, (allowing for the execution of +;; an entire subtree of forms) +;; 2) use the org-mode style src blocks, rather than the muse style +;; <code></code> blocks +;; 3) forms are not replaced by their outputs, but rather the output +;; is placed in the buffer immediately following the src block +;; commented by `org-eval-light-make-region-example' (when +;; evaluated with a prefix argument no output is placed in the +;; buffer) +;; 4) add defadvice to org-ctrl-c-ctrl-c so that when called inside of +;; a source block it will call `org-eval-light-current-snippet' + +;;; Code: +(require 'org) + +(defgroup org-eval-light nil + "Options concerning including output from commands into the Org-mode buffer." + :tag "Org Eval" + :group 'org) + +(defvar org-eval-light-example-size-cutoff 10 + "The number of lines under which an example is considered +'small', and is exported with the '^:' syntax instead of in a +large example block") + +(defvar org-eval-light-regexp nil) + +(defun org-eval-light-set-interpreters (var value) + (set-default var value) + (setq org-eval-light-regexp + (concat "#\\+begin_src \\(" + (mapconcat 'regexp-quote value "\\|") + "\\)\\([^\000]+?\\)#\\+end_src"))) + +(defcustom org-eval-light-interpreters '("lisp" "emacs-lisp" "ruby" "shell-script") + "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 + +lisp Interpret Emacs Lisp code and display the result +shell Pass command to the shell and display the result +perl The perl interpreter +python Thy python interpreter +ruby The ruby interpreter" + :group 'org-eval-light + :set 'org-eval-light-set-interpreters + :type '(set :greedy t + (const "lisp") + (const "emacs-lisp") + (const "perl") + (const "python") + (const "ruby") + (const "shell"))) + +;;; functions +(defun org-eval-light-inside-snippet () + (interactive) + (save-excursion + (let ((case-fold-search t) + (start-re "^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n") + (end-re "\n#\\+end_src") + (pos (point)) + beg end) + (if (and (setq beg (re-search-backward start-re nil t)) + (setq end (re-search-forward end-re nil t)) + (<= beg pos) (>= end pos)) + t)))) + +(defun org-eval-light-make-region-example (beg end) + "Comment out region using either the '^:' or the BEGIN_EXAMPLE +syntax based on the size of the region as compared to +`org-eval-light-example-size-cutoff'." + (interactive "*r") + (let ((size (abs (- (line-number-at-pos end) + (line-number-at-pos beg))))) + (if (= size 0) + (let ((result (buffer-substring beg end))) + (delete-region beg end) + (insert (concat ": " result))) + (if (<= size org-eval-light-example-size-cutoff) + (save-excursion + (goto-char beg) + (dotimes (n size) + (move-beginning-of-line 1) (insert ": ") (forward-line 1))) + (let ((result (buffer-substring beg end))) + (delete-region beg end) + (insert (concat "#+BEGIN_EXAMPLE\n" result "#+END_EXAMPLE\n"))))))) + +(defun org-eval-light-current-snippet (&optional arg) + "Execute the current #+begin_src #+end_src block, and dump the +results into the buffer immediately following the src block, +commented by `org-eval-light-make-region-example'." + (interactive "P") + (let ((line (org-current-line)) + (case-fold-search t) + (info (org-edit-src-find-region-and-lang)) + beg end lang result) + (setq beg (nth 0 info) + end (nth 1 info) + lang (nth 2 info)) + (unless (member lang org-eval-light-interpreters) + (error "Language is not in `org-eval-light-interpreters': %s" lang)) + (goto-line line) + (setq result (org-eval-light-code lang (buffer-substring beg end))) + (unless arg + (save-excursion + (re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2) + (let ((beg (point)) + (end (progn (insert result) + (point)))) + (message (format "from %S %S" beg end)) + (org-eval-light-make-region-example beg end)))))) + +(defun org-eval-light-eval-subtree (&optional arg) + "Replace EVAL snippets in the entire subtree." + (interactive "P") + (save-excursion + (org-narrow-to-subtree) + (goto-char (point-min)) + (while (re-search-forward org-eval-light-regexp nil t) + (org-eval-light-current-snippet arg)) + (widen))) + +(defun org-eval-light-code (interpreter code) + (cond + ((member interpreter '("lisp" "emacs-lisp")) + (org-eval-light-lisp (concat "(progn\n" code "\n)"))) + ((equal interpreter "shell") + (shell-command-to-string code)) + ((member interpreter '("perl" "python" "ruby")) + (org-eval-light-run (executable-find interpreter) code)) + (t (error "Cannot evaluate code type %s" interpreter)))) + +(defun org-eval-light-lisp (form) + "Evaluate the given form and return the result as a string." + (require 'pp) + (save-match-data + (condition-case err + (let ((object (eval (read form)))) + (cond + ((stringp object) object) + ((and (listp object) + (not (eq object nil))) + (let ((string (pp-to-string object))) + (substring string 0 (1- (length string))))) + ((numberp object) + (number-to-string object)) + ((eq object nil) "") + (t + (pp-to-string object)))) + (error + (org-display-warning (format "%s: Error evaluating %s: %s" + "???" form err)) + "; INVALID LISP CODE")))) + +(defun org-eval-light-run (cmd code) + (with-temp-buffer + (insert code) + (shell-command-on-region (point-min) (point-max) cmd nil 'replace) + (buffer-string))) + +(defadvice org-ctrl-c-ctrl-c (around org-cc-eval-source activate) + (if (org-eval-light-inside-snippet) + (call-interactively 'org-eval-light-current-snippet) + ad-do-it)) + +(provide 'org-eval-light) +;;; org-eval-light.el ends here
\ No newline at end of file diff --git a/contrib/lisp/org-exp-blocks.el b/contrib/lisp/org-exp-blocks.el new file mode 100644 index 0000000..26b999d --- /dev/null +++ b/contrib/lisp/org-exp-blocks.el @@ -0,0 +1,378 @@ +;;; org-exp-blocks.el --- pre-process blocks when exporting org files + +;; Copyright (C) 2008 Eric Schulte + +;; Author: Eric Schulte + +;; This file is not currently part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; This is a utility for pre-processing blocks in org files before +;; export using the `org-export-preprocess-hook'. It can be used for +;; exporting new types of blocks from org-mode files and also for +;; changing the default export behavior of existing org-mode blocks. +;; The `org-export-blocks' and `org-export-interblocks' alist can be +;; used to control how blocks and the spaces between blocks +;; respectively are processed upon export. +;; +;; The type of a block is defined as the string following =#+begin_=, +;; so for example the following block would be of type ditaa. Note +;; that both upper or lower case are allowed in =#+BEGIN_= and +;; =#+END_=. +;; +;; #+begin_ditaa blue.png -r -S +;; +---------+ +;; | cBLU | +;; | | +;; | +----+ +;; | |cPNK| +;; | | | +;; +----+----+ +;; #+end_ditaa +;; +;;; Currently Implemented Block Types +;; +;; ditaa :: Convert ascii pictures to actual images using ditaa +;; http://ditaa.sourceforge.net/. To use this set +;; `org-ditaa-jar-path' to the path to ditaa.jar on your +;; system (should be set automatically in most cases) . +;; +;; dot :: Convert graphs defined using the dot graphing language to +;; images using the dot utility. For information on dot see +;; http://www.graphviz.org/ +;; +;; comment :: Wrap comments with titles and author information, in +;; their own divs with author-specific ids allowing for css +;; coloring of comments based on the author. +;; +;; R :: Implements Sweave type exporting, evaluates blocks of R code, +;; and also replaces \R{} chunks in the file with their result +;; when passed to R. This require the `R' command which is +;; provided by ESS (Emacs Speaks Statistics). + +(defcustom org-export-blocks + '((comment org-export-blocks-format-comment) + (ditaa org-export-blocks-format-ditaa) + (dot org-export-blocks-format-dot) + (r org-export-blocks-format-R) + (R org-export-blocks-format-R)) + "Use this a-list to associate block types with block exporting +functions. The type of a block is determined by the text +immediately following the '#+BEGIN_' portion of the block header. +Each block export function should accept three argumets..." + :group 'org-export-general + :type 'alist) + +(defcustom org-export-interblocks + '((r org-export-interblocks-format-R) + (R org-export-interblocks-format-R)) + "Use this a-list to associate block types with block exporting +functions. The type of a block is determined by the text +immediately following the '#+BEGIN_' portion of the block header. +Each block export function should accept three argumets..." + :group 'org-export-general + :type 'alist) + +(defcustom org-export-blocks-witheld + '(hidden) + "List of block types (see `org-export-blocks') which should not +be exported." + :group 'org-export-general + :type 'list) + +(defvar org-export-blocks-postblock-hooks nil "") + +(defun org-export-blocks-html-quote (body &optional open close) + "Protext BODY from org html export. The optional OPEN and +CLOSE tags will be inserted around BODY." + (concat + "\n#+BEGIN_HTML\n" + (or open "") + body (if (string-match "\n$" body) "" "\n") + (or close "") + "#+END_HTML\n")) + +(defun org-export-blocks-latex-quote (body &optional open close) + "Protext BODY from org latex export. The optional OPEN and +CLOSE tags will be inserted around BODY." + (concat + "\n#+BEGIN_LaTeX\n" + (or open "") + body (if (string-match "\n$" body) "" "\n") + (or close "") + "#+END_LaTeX\n")) + +(defun org-export-blocks-preprocess () + "Export all blocks acording to the `org-export-blocks' block +exportation alist. Does not export block types specified in +specified in BLOCKS which default to the value of +`org-export-blocks-witheld'." + (interactive) + (save-window-excursion + (let ((count 0) + (blocks org-export-blocks-witheld) + (case-fold-search t) + (types '()) + type func start end) + (flet ((interblock (start end type) + (save-match-data + (when (setf func (cadr (assoc type org-export-interblocks))) + (funcall func start end))))) + (goto-char (point-min)) + (setf start (point)) + (while (re-search-forward + "^#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)#\\+end_\\S-*[\r\n]" nil t) + (save-match-data (setf type (intern (match-string 1)))) + (unless (memq type types) (setf types (cons type types))) + (setf end (save-match-data (match-beginning 0))) + (interblock start end type) + (if (setf func (cadr (assoc type org-export-blocks))) + (replace-match (save-match-data + (if (memq type blocks) + "" + (apply func (match-string 3) (split-string (match-string 2) " ")))) t t)) + (setf start (save-match-data (match-end 0)))) + (mapcar (lambda (type) + (interblock start (point-max) type)) + types))))) + +(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) + +;;================================================================================ +;; type specific functions + +;;-------------------------------------------------------------------------------- +;; ditaa: create images from ASCII art using the ditaa utility +(defvar org-ditaa-jar-path (expand-file-name + "ditaa.jar" + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + ".." + (file-name-directory (or load-file-name buffer-file-name))))))) + "Path to the ditaa jar executable") + +(defun org-export-blocks-format-ditaa (body &rest headers) + "Pass block BODY to the ditaa utility creating an image. +Specify the path at which the image should be saved as the first +element of headers, any additional elements of headers will be +passed to the ditaa utility as command line arguments." + (message "ditaa-formatting...") + (let ((out-file (if headers (car headers))) + (args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) + (data-file (make-temp-file "org-ditaa"))) + (unless (file-exists-p org-ditaa-jar-path) + (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) + (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) + body + (mapconcat (lambda (x) (substring x 2)) + (org-split-string body "\n") + "\n"))) + (cond + ((or htmlp latexp) + (with-temp-file data-file (insert body)) + (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; dot: create graphs using the dot graphing language +;; (require the dot executable to be in your path) +(defun org-export-blocks-format-dot (body &rest headers) + "Pass block BODY to the dot graphing utility creating an image. +Specify the path at which the image should be saved as the first +element of headers, any additional elements of headers will be +passed to the dot utility as command line arguments. Don't +forget to specify the output type for the dot command, so if you +are exporting to a file with a name like 'image.png' you should +include a '-Tpng' argument, and your block should look like the +following. + +#+begin_dot models.png -Tpng +digraph data_relationships { + \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"] + \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"] + \"data_requirement\" -> \"data_product\" +} +#+end_dot" + (message "dot-formatting...") + (let ((out-file (if headers (car headers))) + (args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) + (data-file (make-temp-file "org-ditaa"))) + (cond + ((or htmlp latexp) + (with-temp-file data-file (insert body)) + (message (concat "dot " data-file " " args " -o " out-file)) + (shell-command (concat "dot " data-file " " args " -o " out-file)) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; comment: export comments in author-specific css-stylable divs +(defun org-export-blocks-format-comment (body &rest headers) + "Format comment BODY by OWNER and return it formatted for export. +Currently, this only does something for HTML export, for all +other backends, it converts the comment into an EXAMPLE segment." + (let ((owner (if headers (car headers))) + (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) + (cond + (htmlp ;; We are exporting to HTML + (concat "#+BEGIN_HTML\n" + "<div class=\"org-comment\"" + (if owner (format " id=\"org-comment-%s\" " owner)) + ">\n" + (if owner (concat "<b>" owner "</b> ") "") + (if (and title (> (length title) 0)) (concat " -- " title "</br>\n") "</br>\n") + "<p>\n" + "#+END_HTML\n" + body + "#+BEGIN_HTML\n" + "</p>\n" + "</div>\n" + "#+END_HTML\n")) + (t ;; This is not HTML, so just make it an example. + (concat "#+BEGIN_EXAMPLE\n" + (if title (concat "Title:" title "\n") "") + (if owner (concat "By:" owner "\n") "") + body + (if (string-match "\n\\'" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; R: Sweave-type functionality +(defvar interblock-R-buffer nil + "Holds the buffer for the current R process") + +(defun org-export-blocks-format-R (body &rest headers) + "Process R blocks and replace \R{} forms outside the blocks +with their values as determined by R." + (interactive) + (message "R processing...") + (let ((image-path (or (and (car headers) + (string-match "\\(.?\\)\.\\(EPS\\|eps\\)" (car headers)) + (match-string 1 (car headers))) + (and (> (length (car headers)) 0) + (car headers)) + ;; create the default filename + (format "Rplot-%03d" count))) + (plot (string-match "plot" body)) + R-proc) + (setf count (+ count 1)) + (interblock-initiate-R-buffer) + (setf R-proc (get-buffer-process interblock-R-buffer)) + ;; send strings to the ESS process using `comint-send-string' + (setf body (mapconcat (lambda (line) + (interblock-R-input-command line) (concat "> " line)) + (butlast (split-string body "[\r\n]")) + "\n")) + ;; if there is a plot command, then create the images + (when plot + (interblock-R-input-command (format "dev.copy2eps(file=\"%s.eps\")" image-path))) + (concat (cond + (htmlp (org-export-blocks-html-quote body + (format "<div id=\"R-%d\">\n<pre>\n" count) + "</pre>\n</div>\n")) + (latexp (org-export-blocks-latex-quote body + "\\begin{Schunk}\n\\begin{Sinput}\n" + "\\end{Sinput}\n\\end{Schunk}\n")) + (t (insert ;; default export + "#+begin_R " (mapconcat 'identity headers " ") "\n" + body (if (string-match "\n$" body) "" "\n") + "#+end_R\n"))) + (if plot + (format "[[file:%s.eps]]\n" image-path) + "")))) + +(defun org-export-interblocks-format-R (start end) + "This is run over parts of the org-file which are between R +blocks. It's main use is to expand the \R{stuff} chunks for +export." + (save-excursion + (goto-char start) + (interblock-initiate-R-buffer) + (let (code replacement) + (while (and (< (point) end) (re-search-forward "\\\\R{\\(.*\\)}" end t)) + (save-match-data (setf code (match-string 1))) + (setf replacement (interblock-R-command-to-string code)) + (setf replacement (cond + (htmlp replacement) + (latexp replacement) + (t replacement))) + (setf end (+ end (- (length replacement) (length code)))) + (replace-match replacement t t))))) + +(defun interblock-initiate-R-buffer () + "If there is not a current R process then create one." + (unless (and (buffer-live-p interblock-R-buffer) (get-buffer interblock-R-buffer)) + (save-excursion + (R) + (setf interblock-R-buffer (current-buffer)) + (interblock-R-wait-for-output) + (interblock-R-input-command "")))) + +(defun interblock-R-command-to-string (command) + "Send a command to R, and return the results as a string." + (interblock-R-input-command command) + (interblock-R-last-output)) + +(defun interblock-R-input-command (command) + "Pass COMMAND to the R process running in `interblock-R-buffer'." + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert command) + (comint-send-input) + (interblock-R-wait-for-output)))) + +(defun interblock-R-wait-for-output () + "Wait until output arrives" + (save-excursion + (save-match-data + (set-buffer interblock-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 interblock-R-last-output () + "Return the last R output as a string" + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (forward-line 0) + (let ((raw (buffer-substring comint-last-input-end (- (point) 1)))) + (if (string-match "\n" raw) + raw + (and (string-match "\\[[[:digit:]+]\\] *\\(.*\\)$" raw) + (message raw) + (message (match-string 1 raw)) + (match-string 1 raw))))))) + +;;; org-exp-blocks.el ends here
\ No newline at end of file |