contrib/lisp/org-eval.el

   1 ;;; org-eval.el --- Display result of evaluating code in various languanges
   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.01
   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 (require 'org)
  30
  31 ;;; Customization
  32
  33 (defgroup org-eval nil
  34   "Options concerning global entry identifiers in Org-mode."
  35   :tag "Org ID"
  36   :group 'org)
  37
  38 (defface org-eval
  39   (org-compatible-face nil
  40     '((((class color grayscale) (min-colors 88) (background light))
  41        (:foreground "grey20"))
  42       (((class color grayscale) (min-colors 88) (background dark))
  43        (:foreground "grey80"))
  44       (((class color) (min-colors 8) (background light))
  45        (:foreground "green"))
  46       (((class color) (min-colors 8) (background dark))
  47        (:foreground "yellow"))))
  48   "Face for fixed-with text like code snippets."
  49   :group 'org-eval
  50   :group 'org-faces
  51   :version "22.1")
  52
  53 (defun org-eval-handle-snippets (limit &optional replace)
  54   (let (a)
  55     (while (setq a (text-property-any (point) (or limit (point-max))
  56                                       'org-eval t))
  57       (remove-text-properties
  58        a (next-single-property-change a 'org-eval nil limit)
  59        '(display t intangible t org-eval t))))
  60   (while (re-search-forward "<\\(lisp\\)>\\([^\000]+?\\)</\\1>" limit t)
  61     (let* ((beg (match-beginning 0))
  62            (end (match-end 0))
  63            (kind (match-string 1))
  64            (code (match-string 2))
  65            (value (org-eval-code kind code)))
  66       (if replace
  67           (replace-match value t t)
  68         (add-text-properties
  69          beg end
  70          (list 'display value 'intangible t 'font-lock-multiline t
  71                'face 'org-eval
  72                'org-eval t))))))
  73
  74 (defun org-eval-replace-snippts ()
  75   "Replace EVAL snippets in the entire buffer.
  76 This should go into the `org-export-preprocess-hook'."
  77   (goto-char (point-min))
  78   (org-eval-handle-snippets nil 'replace))
  79
  80 (add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
  81 (add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
  82
  83 (defun org-eval-code (interpreter code)
  84   (cond
  85    ((equal interpreter "lisp")
  86     (org-eval-lisp (concat "(progn\n" code "\n)")))
  87    (t (error "Cannot evaluate code type %s" interpreter))))
  88
  89 (defun org-eval-lisp (form)
  90   "Evaluate the given form and return the result as a string."
  91   (require 'pp)
  92   (save-match-data
  93     (condition-case err
  94         (let ((object (eval (read form))))
  95           (cond
  96            ((stringp object) object)
  97            ((and (listp object)
  98                  (not (eq object nil)))
  99             (let ((string (pp-to-string object)))
 100               (substring string 0 (1- (length string)))))
 101            ((numberp object)
 102             (number-to-string object))
 103            ((eq object nil) "")
 104            (t
 105             (pp-to-string object))))
 106       (error
 107        (org-display-warning (format "%s: Error evaluating %s: %s"
 108                                      "???" form err))
 109        "; INVALID LISP CODE"))))
 110
 111 (defun org-display-warning (message)
 112   "Display the given MESSAGE as a warning."
 113   (if (fboundp 'display-warning)
 114       (display-warning 'org message
 115                        (if (featurep 'xemacs)
 116                            'warning
 117                          :warning))
 118     (let ((buf (get-buffer-create "*Org warnings*")))
 119       (with-current-buffer buf
 120         (goto-char (point-max))
 121         (insert "Warning (Org): " message)
 122         (unless (bolp)
 123           (newline)))
 124       (display-buffer buf)
 125       (sit-for 0))))
 126
 127 (provide 'org-eval)
 128
 129 ;;; org-eval.el ends here
 130