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 ;; Please note that this mechanism is potentially dangerous, because it
  60 ;; executes code that you don't even see.  This gives you great power,
  61 ;; but also enough rope to hang yourself.  And, it gives your friends
  62 ;; who send you Org files plenty of opportunity for good and bad jokes.
  63 ;; This is also why this module is not turned on by default, but only
  64 ;; available as a contributed package.
  65 ;;
  66 ;;
  67 ;;
  68 (require 'org)
  69
  70 ;;; Customization
  71
  72 (defgroup org-eval nil
  73   "Options concerning including output from commands into the Org-mode buffer."
  74   :tag "Org Eval"
  75   :group 'org)
  76
  77 (defface org-eval
  78   (org-compatible-face nil
  79     '((((class color grayscale) (min-colors 88) (background light))
  80        (:foreground "grey40"))
  81       (((class color grayscale) (min-colors 88) (background dark))
  82        (:foreground "grey60"))
  83       (((class color) (min-colors 8) (background light))
  84        (:foreground "green"))
  85       (((class color) (min-colors 8) (background dark))
  86        (:foreground "yellow"))))
  87   "Face for command output that is included into an Org-mode buffer."
  88   :group 'org-eval
  89   :group 'org-faces
  90   :version "22.1")
  91
  92 (defvar org-eval-regexp nil)
  93
  94 (defun org-eval-set-interpreters (var value)
  95   (set-default var value)
  96   (setq org-eval-regexp
  97         (concat "<\\("
  98                 (mapconcat 'regexp-quote value "\\|")
  99                 "\\)"
 100                 "\\([^>]\\{0,50\\}?\\)>"
 101                 "\\([^\000]+?\\)</\\1>")))
 102
 103 (defcustom org-eval-interpreters '("lisp")
 104   "Interpreters allows for evaluation tags.
 105 This is a list of program names (as strings) that can evaluate code and
 106 insert the output into an Org-mode buffer.  Valid choices are
 107
 108 lisp    Interpret Emacs Lisp code and display the result
 109 shell   Pass command to the shell and display the result
 110 perl    The perl interpreter
 111 python  Thy python interpreter
 112 ruby    The ruby interpreter"
 113   :group 'org-eval
 114   :set 'org-eval-set-interpreters
 115   :type '(set :greedy t
 116               (const "lisp")
 117               (const "perl")
 118               (const "python")
 119               (const "ruby")
 120               (const "shell")))
 121
 122 (defun org-eval-handle-snippets (limit &optional replace)
 123   "Evaluate code nisppets and display the results as display property.
 124 When REPLACE is non-nil, replace the code region with the result (used
 125 for export)."
 126   (let (a)
 127     (while (setq a (text-property-any (point) (or limit (point-max))
 128                                       'org-eval t))
 129       (remove-text-properties
 130        a (next-single-property-change a 'org-eval nil limit)
 131        '(display t intangible t org-eval t))))
 132   (while (re-search-forward org-eval-regexp limit t)
 133     (let* ((beg (match-beginning 0))
 134            (end (match-end 0))
 135            (kind (match-string 1))
 136            (attr (match-string 2))
 137            (code (match-string 3))
 138            (value (org-eval-code kind code))
 139            markup lang)
 140       (if replace
 141           (progn
 142             (setq attr (save-match-data (org-eval-get-attributes attr))
 143                   markup (cdr (assoc "markup" attr))
 144                   lang  (cdr (assoc "lang" attr)))
 145             (replace-match
 146              (concat (if markup (format "#+BEGIN_%s" (upcase markup)))
 147                      (if (and markup (equal (downcase markup) "src"))
 148                          (concat " " (or lang "fundamental")))
 149                      "\n"
 150                      value
 151                      (if markup (format "\n#+END_%s\n" (upcase markup))))
 152              t t))
 153         (add-text-properties
 154          beg end
 155          (list 'display value 'intangible t 'font-lock-multiline t
 156                'face 'org-eval
 157                'org-eval t))))))
 158
 159 (defun org-eval-replace-snippts ()
 160   "Replace EVAL snippets in the entire buffer.
 161 This should go into the `org-export-preprocess-hook'."
 162   (goto-char (point-min))
 163   (org-eval-handle-snippets nil 'replace))
 164
 165 (add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
 166 (add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
 167
 168 (defun org-eval-get-attributes (str)
 169   (let ((start 0) key value rtn)
 170     (while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start)
 171       (setq key (match-string 1 str)
 172             value (match-string 2 str)
 173             start (match-end 0))
 174       (push (cons key value) rtn))
 175     rtn))
 176
 177 (defun org-eval-code (interpreter code)
 178   (cond
 179    ((equal interpreter "lisp")
 180     (org-eval-lisp (concat "(progn\n" code "\n)")))
 181    ((equal interpreter "shell")
 182     (shell-command-to-string code))
 183    ((member interpreter '("perl" "python" "ruby"))
 184     (org-eval-run (executable-find interpreter) code))
 185    (t (error "Cannot evaluate code type %s" interpreter))))
 186
 187 (defun org-eval-lisp (form)
 188   "Evaluate the given form and return the result as a string."
 189   (require 'pp)
 190   (save-match-data
 191     (condition-case err
 192         (let ((object (eval (read form))))
 193           (cond
 194            ((stringp object) object)
 195            ((and (listp object)
 196                  (not (eq object nil)))
 197             (let ((string (pp-to-string object)))
 198               (substring string 0 (1- (length string)))))
 199            ((numberp object)
 200             (number-to-string object))
 201            ((eq object nil) "")
 202            (t
 203             (pp-to-string object))))
 204       (error
 205        (org-display-warning (format "%s: Error evaluating %s: %s"
 206                                      "???" form err))
 207        "; INVALID LISP CODE"))))
 208
 209 (defun org-eval-run (cmd code)
 210   (with-temp-buffer
 211     (insert code)
 212     (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
 213     (buffer-string)))
 214
 215 (provide 'org-eval)
 216
 217 ;;; org-eval.el ends here
 218