contrib/lisp/org-eval.el

   1 ;;; org-eval.el --- Display result of evaluating code in various languages
   2 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   3 ;;
   4 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   5 ;; Keywords: outlines, hypermedia, calendar, wp
   6 ;; Homepage: http://orgmode.org
   7 ;; Version: 0.04
   8 ;;
   9 ;; This file is not yet part of GNU Emacs.
  10 ;;
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;;
  27 ;;; Commentary:
  28 ;;
  29 ;; This modules allows to include output from various commands into an
  30 ;; Org-mode buffer, both for live display, and for export.
  31 ;; This technique has been copied from emacs-wiki and Emacs Muse, and
  32 ;; we try to make it work here in a way as similar as possible to
  33 ;; Muse, so that people who move between both worlds don't need to learn
  34 ;; new syntax.
  35 ;;
  36 ;; Basically it works like this:
  37 ;;
  38 ;;    <lisp>(concat "aaa" "bbb")</lisp>
  39 ;;
  40 ;; will display "aaabbb" in the buffer and export like that as well.
  41 ;; The leading lisp tag will also accept the attributes "markup" and
  42 ;; "lang", to specify how the text should be formatted during export.
  43 ;; For example,
  44 ;;
  45 ;;    <lisp markup="src" lang="emacs-lisp"> .... </lisp>
  46 ;;
  47 ;; will format the result of the lisp form as if it was lisp source
  48 ;; code.  Internally, it will wrap the text into a
  49 ;;
  50 ;;    #+begin_src emacs-lisp
  51 ;;    #+end_src
  52 ;;
  53 ;; structure so that the right things happen when the exporter is running.
  54 ;;
  55 ;; By default, only the <lisp> tag is turned on, but you can configure
  56 ;; the variable `org-eval-interpreters' to add more interpreters like
  57 ;; `perl', `python', or the `shell'.
  58 ;;
  59 ;; You can edit the code snippets with "C-c '" (org-edit-src-code).
  60 ;;
  61 ;; Please note that this mechanism is potentially dangerous, because it
  62 ;; executes code that you don't even see.  This gives you great power,
  63 ;; but also enough rope to hang yourself.  And, it gives your friends
  64 ;; who send you Org files plenty of opportunity for good and bad jokes.
  65 ;; This is also why this module is not turned on by default, but only
  66 ;; available as a contributed package.
  67 ;;
  68 ;;
  69 ;;
  70 (require 'org)
  71
  72 ;;; Customization
  73
  74 (defgroup org-eval nil
  75   "Options concerning including output from commands into the Org-mode buffer."
  76   :tag "Org Eval"
  77   :group 'org)
  78
  79 (defface org-eval
  80   (org-compatible-face nil
  81     '((((class color grayscale) (min-colors 88) (background light))
  82        (:foreground "grey40"))
  83       (((class color grayscale) (min-colors 88) (background dark))
  84        (:foreground "grey60"))
  85       (((class color) (min-colors 8) (background light))
  86        (:foreground "green"))
  87       (((class color) (min-colors 8) (background dark))
  88        (:foreground "yellow"))))
  89   "Face for command output that is included into an Org-mode buffer."
  90   :group 'org-eval
  91   :group 'org-faces
  92   :version "22.1")
  93
  94 (defvar org-eval-regexp nil)
  95
  96 (defun org-eval-set-interpreters (var value)
  97   (set-default var value)
  98   (setq org-eval-regexp
  99         (concat "<\\("
 100                 (mapconcat 'regexp-quote value "\\|")
 101                 "\\)"
 102                 "\\([^>]\\{0,50\\}?\\)>"
 103                 "\\([^\000]+?\\)</\\1>")))
 104
 105 (defcustom org-eval-interpreters '("lisp")
 106   "Interpreters allows for evaluation tags.
 107 This is a list of program names (as strings) that can evaluate code and
 108 insert the output into an Org-mode buffer.  Valid choices are
 109
 110 lisp    Interpret Emacs Lisp code and display the result
 111 shell   Pass command to the shell and display the result
 112 perl    The perl interpreter
 113 python  Thy python interpreter
 114 ruby    The ruby interpreter"
 115   :group 'org-eval
 116   :set 'org-eval-set-interpreters
 117   :type '(set :greedy t
 118               (const "lisp")
 119               (const "perl")
 120               (const "python")
 121               (const "ruby")
 122               (const "shell")))
 123
 124 (defun org-eval-handle-snippets (limit &optional replace)
 125   "Evaluate code snippets and display the results as display property.
 126 When REPLACE is non-nil, replace the code region with the result (used
 127 for export)."
 128   (let (a)
 129     (while (setq a (text-property-any (point) (or limit (point-max))
 130                                       'org-eval t))
 131       (remove-text-properties
 132        a (next-single-property-change a 'org-eval nil limit)
 133        '(display t intangible t org-eval t))))
 134   (while (re-search-forward org-eval-regexp limit t)
 135     (let* ((beg (match-beginning 0))
 136            (end (match-end 0))
 137            (kind (match-string 1))
 138            (attr (match-string 2))
 139            (code (match-string 3))
 140            (value (org-eval-code kind code))
 141            markup lang)
 142       (if replace
 143           (progn
 144             (setq attr (save-match-data (org-eval-get-attributes attr))
 145                   markup (cdr (assoc "markup" attr))
 146                   lang  (cdr (assoc "lang" attr)))
 147             (replace-match
 148              (concat (if markup (format "#+BEGIN_%s" (upcase markup)))
 149                      (if (and markup (equal (downcase markup) "src"))
 150                          (concat " " (or lang "fundamental")))
 151                      "\n"
 152                      value
 153                      (if markup (format "\n#+END_%s\n" (upcase markup))))
 154              t t))
 155         (add-text-properties
 156          beg end
 157          (list 'display value 'intangible t 'font-lock-multiline t
 158                'face 'org-eval
 159                'org-eval t))))))
 160
 161 (defun org-eval-replace-snippts ()
 162   "Replace EVAL snippets in the entire buffer.
 163 This should go into the `org-export-preprocess-hook'."
 164   (goto-char (point-min))
 165   (org-eval-handle-snippets nil 'replace))
 166
 167 (add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
 168 (add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
 169
 170 (defun org-eval-get-attributes (str)
 171   (let ((start 0) key value rtn)
 172     (while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start)
 173       (setq key (match-string 1 str)
 174             value (match-string 2 str)
 175             start (match-end 0))
 176       (push (cons key value) rtn))
 177     rtn))
 178
 179 (defun org-eval-code (interpreter code)
 180   (cond
 181    ((equal interpreter "lisp")
 182     (org-eval-lisp (concat "(progn\n" code "\n)")))
 183    ((equal interpreter "shell")
 184     (shell-command-to-string code))
 185    ((member interpreter '("perl" "python" "ruby"))
 186     (org-eval-run (executable-find interpreter) code))
 187    (t (error "Cannot evaluate code type %s" interpreter))))
 188
 189 (defun org-eval-lisp (form)
 190   "Evaluate the given form and return the result as a string."
 191   (require 'pp)
 192   (save-match-data
 193     (condition-case err
 194         (let ((object (eval (read form))))
 195           (cond
 196            ((stringp object) object)
 197            ((and (listp object)
 198                  (not (eq object nil)))
 199             (let ((string (pp-to-string object)))
 200               (substring string 0 (1- (length string)))))
 201            ((numberp object)
 202             (number-to-string object))
 203            ((eq object nil) "")
 204            (t
 205             (pp-to-string object))))
 206       (error
 207        (org-display-warning (format "%s: Error evaluating %s: %s"
 208                                      "???" form err))
 209        "; INVALID LISP CODE"))))
 210
 211 (defun org-eval-run (cmd code)
 212   (with-temp-buffer
 213     (insert code)
 214     (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
 215     (buffer-string)))
 216
 217 (provide 'org-eval)
 218
 219 ;;; org-eval.el ends here
 220