org-eval.el 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  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. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  21. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22. ;; Boston, MA 02110-1301, USA.
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24. ;;
  25. ;;; Commentary:
  26. (require 'org)
  27. ;;; Customization
  28. (defgroup org-eval nil
  29. "Options concerning global entry identifiers in Org-mode."
  30. :tag "Org ID"
  31. :group 'org)
  32. (defface org-eval
  33. (org-compatible-face nil
  34. '((((class color grayscale) (min-colors 88) (background light))
  35. (:foreground "grey20"))
  36. (((class color grayscale) (min-colors 88) (background dark))
  37. (:foreground "grey80"))
  38. (((class color) (min-colors 8) (background light))
  39. (:foreground "green"))
  40. (((class color) (min-colors 8) (background dark))
  41. (:foreground "yellow"))))
  42. "Face for fixed-with text like code snippets."
  43. :group 'org-eval
  44. :group 'org-faces
  45. :version "22.1")
  46. (defun org-eval-handle-snippets (limit &optional replace)
  47. (let (a)
  48. (while (setq a (text-property-any (point) (or limit (point-max))
  49. 'org-eval t))
  50. (remove-text-properties
  51. a (next-single-property-change a 'org-eval nil limit)
  52. '(display t intangible t org-eval t))))
  53. (while (re-search-forward "<\\(lisp\\)>\\([^\000]+?\\)</\\1>" limit t)
  54. (let* ((beg (match-beginning 0))
  55. (end (match-end 0))
  56. (kind (match-string 1))
  57. (code (match-string 2))
  58. (value (org-eval-code kind code)))
  59. (if replace
  60. (replace-match value t t)
  61. (add-text-properties
  62. beg end
  63. (list 'display value 'intangible t 'font-lock-multiline t
  64. 'face 'org-eval
  65. 'org-eval t))))))
  66. (defun org-eval-replace-snippts ()
  67. "Replace EVAL snippets in the entire buffer.
  68. This should go into the `org-export-preprocess-hook'."
  69. (goto-char (point-min))
  70. (org-eval-handle-snippets nil 'replace))
  71. (add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
  72. (add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
  73. (defun org-eval-code (interpreter code)
  74. (cond
  75. ((equal interpreter "lisp")
  76. (org-eval-lisp (concat "(progn\n" code "\n)")))
  77. (t (error "Cannot evaluate code type %s" interpreter))))
  78. (defun org-eval-lisp (form)
  79. "Evaluate the given form and return the result as a string."
  80. (require 'pp)
  81. (save-match-data
  82. (condition-case err
  83. (let ((object (eval (read form))))
  84. (cond
  85. ((stringp object) object)
  86. ((and (listp object)
  87. (not (eq object nil)))
  88. (let ((string (pp-to-string object)))
  89. (substring string 0 (1- (length string)))))
  90. ((numberp object)
  91. (number-to-string object))
  92. ((eq object nil) "")
  93. (t
  94. (pp-to-string object))))
  95. (error
  96. (org-display-warning (format "%s: Error evaluating %s: %s"
  97. "???" form err))
  98. "; INVALID LISP CODE"))))
  99. (defun org-display-warning (message)
  100. "Display the given MESSAGE as a warning."
  101. (if (fboundp 'display-warning)
  102. (display-warning 'org message
  103. (if (featurep 'xemacs)
  104. 'warning
  105. :warning))
  106. (let ((buf (get-buffer-create "*Org warnings*")))
  107. (with-current-buffer buf
  108. (goto-char (point-max))
  109. (insert "Warning (Org): " message)
  110. (unless (bolp)
  111. (newline)))
  112. (display-buffer buf)
  113. (sit-for 0))))
  114. (provide 'org-eval)
  115. ;;; org-eval.el ends here