contrib/lisp/org-mtags.el

   1 ;;; org-mtags.el --- Muse-like tags in Org-mode
   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 ;; This modules implements some of the formatting tags available in
  30 ;; Emacs Muse.  The goal of this devellopment is to  make it easier for
  31 ;; people to move between both worlds, and eventually to allow Org files
  32 ;; to be published as parts of the Muse environment.
  33
  34 (require 'org)
  35
  36 ;;; Customization
  37
  38 (defgroup org-eval nil
  39   "Options concerning including output from commands into the Org-mode buffer."
  40   :tag "Org Eval"
  41   :group 'org)
  42
  43 (defface org-eval
  44   (org-compatible-face nil
  45     '((((class color grayscale) (min-colors 88) (background light))
  46        (:foreground "grey40"))
  47       (((class color grayscale) (min-colors 88) (background dark))
  48        (:foreground "grey60"))
  49       (((class color) (min-colors 8) (background light))
  50        (:foreground "green"))
  51       (((class color) (min-colors 8) (background dark))
  52        (:foreground "yellow"))))
  53   "Face for command output that is included into an Org-mode buffer."
  54   :group 'org-eval
  55   :group 'org-faces
  56   :version "22.1")
  57
  58 (defvar org-eval-regexp nil)
  59
  60 (defun org-eval-set-interpreters (var value)
  61   (set-default var value)
  62   (setq org-eval-regexp
  63         (concat "<\\("
  64                 (mapconcat 'regexp-quote value "\\|")
  65                 "\\)"
  66                 "\\([^>]\\{0,50\\}?\\)>"
  67                 "\\([^\000]+?\\)</\\1>")))
  68
  69 (defcustom org-eval-interpreters '("lisp")
  70   "Interpreters allows for evaluation tags.
  71 This is a list of program names (as strings) that can evaluate code and
  72 insert the output into an Org-mode buffer.  Valid choices are
  73
  74 lisp    Interpret Emacs Lisp code and display the result
  75 shell   Pass command to the shell and display the result
  76 perl    The perl interpreter
  77 python  Thy python interpreter
  78 ruby    The ruby interpreter"
  79   :group 'org-eval
  80   :set 'org-eval-set-interpreters
  81   :type '(set :greedy t
  82               (const "lisp")
  83               (const "perl")
  84               (const "python")
  85               (const "ruby")
  86               (const "shell")))
  87
  88 (defun org-eval-handle-snippets (limit &optional replace)
  89   "Evaluate code nisppets and display the results as display property.
  90 When REPLACE is non-nil, replace the code region with the result (used
  91 for export)."
  92   (let (a)
  93     (while (setq a (text-property-any (point) (or limit (point-max))
  94                                       'org-eval t))
  95       (remove-text-properties
  96        a (next-single-property-change a 'org-eval nil limit)
  97        '(display t intangible t org-eval t))))
  98   (while (re-search-forward org-eval-regexp limit t)
  99     (let* ((beg (match-beginning 0))
 100            (end (match-end 0))
 101            (kind (match-string 1))
 102            (attr (match-string 2))
 103            (code (match-string 3))
 104            (value (org-eval-code kind code))
 105            markup lang)
 106       (if replace
 107           (progn
 108             (setq attr (save-match-data (org-eval-get-attributes attr))
 109                   markup (cdr (assoc "markup" attr))
 110                   lang  (cdr (assoc "lang" attr)))
 111             (replace-match
 112              (concat (if markup (format "#+BEGIN_%s" (upcase markup)))
 113                      (if (and markup (equal (downcase markup) "src"))
 114                          (concat " " (or lang "fundamental")))
 115                      "\n"
 116                      value
 117                      (if markup (format "\n#+END_%s\n" (upcase markup))))
 118              t t))
 119         (add-text-properties
 120          beg end
 121          (list 'display value 'intangible t 'font-lock-multiline t
 122                'face 'org-eval
 123                'org-eval t))))))
 124
 125 (defun org-eval-replace-snippts ()
 126   "Replace EVAL snippets in the entire buffer.
 127 This should go into the `org-export-preprocess-hook'."
 128   (goto-char (point-min))
 129   (org-eval-handle-snippets nil 'replace))
 130
 131 (add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
 132 (add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
 133
 134 (defun org-eval-get-attributes (str)
 135   (let ((start 0) key value rtn)
 136     (while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start)
 137       (setq key (match-string 1 str)
 138             value (match-string 2 str)
 139             start (match-end 0))
 140       (push (cons key value) rtn))
 141     rtn))
 142
 143 (defun org-eval-code (interpreter code)
 144   (cond
 145    ((equal interpreter "lisp")
 146     (org-eval-lisp (concat "(progn\n" code "\n)")))
 147    ((equal interpreter "shell")
 148     (shell-command-to-string code))
 149    ((member interpreter '("perl" "python" "ruby"))
 150     (org-eval-run (executable-find interpreter) code))
 151    (t (error "Cannot evaluate code type %s" interpreter))))
 152
 153 (defun org-eval-lisp (form)
 154   "Evaluate the given form and return the result as a string."
 155   (require 'pp)
 156   (save-match-data
 157     (condition-case err
 158         (let ((object (eval (read form))))
 159           (cond
 160            ((stringp object) object)
 161            ((and (listp object)
 162                  (not (eq object nil)))
 163             (let ((string (pp-to-string object)))
 164               (substring string 0 (1- (length string)))))
 165            ((numberp object)
 166             (number-to-string object))
 167            ((eq object nil) "")
 168            (t
 169             (pp-to-string object))))
 170       (error
 171        (org-display-warning (format "%s: Error evaluating %s: %s"
 172                                      "???" form err))
 173        "; INVALID LISP CODE"))))
 174
 175 (defun org-eval-run (cmd code)
 176   (with-temp-buffer
 177     (insert code)
 178     (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
 179     (buffer-string)))
 180
 181 (provide 'org-eval)
 182
 183 ;;; org-eval.el ends here
 184